Excel 数据库如下,包含行标题及对应数据,本篇使用的 Excel 数据库均为此格式。

除了 Excel 数据库,还有 Access 数据库等。本节课学习如何用 VBA 操作专业数据库,共讲解 5 节内容。
一、基本概念
- 如何操作数据库?
- SQL 是什么?
- SQL 可以查询哪些数据库?
- ADO 是什么?
- 学习 SQL+ADO 访问数据库有何用处?
- 如何使用 ADO?
使用 ADO 建立与数据库的连接,然后通过 ADO 对象和 SQL 语言操作数据库。
SQL(Structured Query Language)是一种查询语言,可用于查询、更新数据库中的数据。
SQL 是通用的查询语言,可查询 Excel、Access、SQL Server 等多种数据库。
ADO 是新的数据库访问技术,可建立与各种数据库的连接,并支持添加、更新、删除等操作。
① 无需打开 Excel 文件即可从中提取数据。
② 可从专业软件数据库(如财务软件)提取数据。
ADO 是外部工具,类似字典,有两种使用方法:
① 引用法
工具 → 引用 → Microsoft ActiveX Data Objects 2.5

引用后声明:
Dim conn As New Connection '声明链接对象
Dim rst As New Recordset '声明记录集对象
② 创建法
使用 CreateObject 函数创建:
Set conn = CreateObject("adodb.connection") '创建 ADO 对象
Set rst = CreateObject("ADODB.recordset") '创建记录集
二、ADO 的基本对象
- Connection 对象:用于连接数据库。
- Recordset 对象:数据库记录集合,用于打开记录集并操作记录。
三、建立与数据库的连接
Connection对象.Open "引擎版本, 连接的是 Excel 8.0 版本, 数据库路径"
rst.Open sql 或 command 语句等, 已打开的 conn 链接
示例:声明变量 conn 为 Connection 对象并打开数据库链接
Dim conn As New Connection
conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.Path & "/Database/exceldata.xls"
conn.Open:打开数据库连接。provider=microsoft.jet.oledb.4.0:数据库引擎版本,可直接引用,详情可自行查阅。extended properties=excel 8.0:连接 Excel 8.0 版本(Excel 2000 及以上),Excel 非标准数据库格式,需设置扩展属性。data source=" & ThisWorkbook.Path & "/数据库.xls":数据库路径。
其他数据库或文件的连接字符串表达式:
- MySQL 数据库
- TXT 文件
- MSSQL 数据库
- Oracle 数据库
strDriver = "Provider=SQLOLEDB;DataSource=" & Path & ";Initial Catolog=" & strDataName
strDriver = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='text;IMEX=1;HDR=NO;FMT=Delimited;';Data Source=" & Path
strDriver = "Provider=MSDASQL;Driver={SQL Server};Server=" & Path & ";Database=" & strDataName
strDriver = "Provider=madaora;Data Source=MyOracleDB;User Id=UserID;Password=Password"
为方便,可将数据库建立和连接语句写入类模块,避免每个宏重复编写(以下示例均直接调用类模块)。
Option Explicit
Property Get Excel数据库()
Excel数据库 = "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.Path & "/Database/exceldata.xls"
End Property
Property Get Access数据库()
Access数据库 = "provider=Microsoft.jet.OLEDB.4.0;data source=" & ThisWorkbook.Path & "/Database/AccessData.mdb"
End Property
四、执行 SQL 语句
connection对象.Execute SQL
① 增加新表格
.Execute "Create 表格名 字段和属性"
较少使用,需时可另行学习。
② 增加新记录
SQL 语句无分隔符,表名与 VALUES 间用空格分隔,字段括号内的值用逗号分隔,中文字符值需用单引号括起来。
.Execute "Insert into 表名 (字段1, 字段2,... 字段n) VALUES(值1, 值2,... 值n)"
使用 .Execute 执行 Insert 语句。
例 1:在 Excel 数据库添加一条新数据:张雨生, 35, 男
Sub 添加1()
Dim conn As New Connection
Dim sql As String '声明变量 sql 用于存储命令语句
Dim data As New 数据库
conn.Open data.Excel数据库 '打开数据库
sql = "Insert into [Sheet1$] (姓名, 年龄, 性别) VALUES('张雨生', 35, '男')" '编写命令语句
conn.Execute sql '执行命令语句
conn.Close '关闭数据库
Set conn = Nothing '释放对象
End Sub

运行结果
例 2:在 Excel 数据库添加一条新数据:何靖, 23, 女
Sub 添加()
Dim conn As New Connection
Dim rst As New Recordset '新建记录集对象
Dim data As New 数据库
conn.Open data.Excel数据库
rst.Open "select * from [Sheet1$]", conn, adOpenForwardOnly, adLockOptimistic
'打开记录集,获取全部数据。参数可直接复制使用(细节较多,需另行学习),后文会细讲 select 语句
rst.AddNew Array("姓名", "年龄", "性别"), Array("何靖", 23, "女")
rst.Close '关闭记录集
conn.Close '关闭数据库链接
Set rst = Nothing '释放对象
Set conn = Nothing '释放对象
End Sub
或逐一添加单个字段数据:
Fields("字段名") 表示某列的记录。
Sub 添加()
Dim conn As New Connection
Dim rst As New Recordset '新建记录集对象
Dim data As New 数据库
conn.Open data.Excel数据库
rst.Open "select * from [Sheet1$]", conn, adOpenForwardOnly, adLockOptimistic
'打开记录集,获取全部数据。参数可直接复制使用(细节较多,需另行学习),后文会细讲 select 语句
rst.AddNew '添加新记录
rst.Fields("姓名") = "何靖"
rst.Fields("年龄") = 23
rst.Fields("性别") = "女"
rst.Update '更新记录
rst.Close '关闭记录集
conn.Close '关闭数据库链接
Set rst = Nothing '释放对象
Set conn = Nothing '释放对象
End Sub

运行结果
例 3:在 Access 数据库添加一条新数据:何靖, 23, 女
连接方法与 Excel 数据库类似。
Sub 添加到access()
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim sq1 As String
Dim data As New 数据库
cnn.Open data.Access数据库
sq1 = "Select * from 员工" '从员工表查询
rst.Open sq1, cnn, adOpenKeyset, adLockOptimistic
rst.AddNew
rst.Fields("姓名") = "何靖"
rst.Fields("年龄") = 23
rst.Fields("性别") = "女"
rst.Update
cnn.Close '关闭数据库
Set cnn = Nothing '释放对象
End Sub

运行结果
五、删除记录
.Execute "Delete from 表名 where 条件"
注意:Delete 语句不支持 Excel 数据库删除操作,需通过其他方法(如打开后删除)。
例 4:在 Access 数据库删除何靖的记录
Sub ADO删除方法()
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim sq1 As String
Dim data As New 数据库
cnn.Open data.Access数据库
sq1 = "delete from 员工 where 姓名='" & "何靖" & "'" '文本字符需用单引号
cnn.Execute sq1
MsgBox "删除成功"
cnn.Close
Set cnn = Nothing
FindX ("何靖")
End Sub

运行结果
方法二:使用 select 获取需要删除的记录后删除,速度较慢,建议使用第一种方法。
Sub ADO删除方法2()
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim sq1 As String
Dim data As New 数据库
cnn.Open data.Access数据库
sq1 = "select * from 员工 where 姓名='" & "何靖" & "'" '获取需要删除的记录
rst.Open sq1, cnn, adOpenForwardOnly, adLockOptimistic
rst.Delete
MsgBox "删除成功"
cnn.Close
Set cnn = Nothing
FindX ("何靖")
End Sub
六、修改旧记录
使用 Update 语句:
.Execute "Update 表名称 SET 列1 = 新值, 列2 = 新值 WHERE 列名称 = 某值"
注:字段和值可用数组同时更新多个字段信息。
例 5:在 Excel 数据库修改张雨生的年龄从 35 改为 20,性别从男改为女
Sub 记录修改()
Dim conn As New Connection
Dim rst As New Recordset
Dim sql As String
Dim nl As String, xb As String, xm As String
Dim data As New 数据库
xm = "张雨生"
xb = "女"
nl = 20
conn.Open data.Excel数据库 '打开数据库
sql = "update [Sheet1$] set 年龄=" & nl & ",性别='" & xb & "' where 姓名='" & xm & "'"
'单引号不可省略
conn.Execute sql
conn.Close
Set conn = Nothing
MsgBox "数据库的记录已修改"
End Sub

运行结果
方法二:使用集合获取修改数值
Sub 记录修改2()
Dim conn As New Connection
Dim rst As New Recordset
Dim sql As String
Dim nl As String, xb As String, xm As String
Dim data As New 数据库
xm = "张雨生"
xb = "女"
nl = 20
conn.Open data.Excel数据库 '打开数据库
sql = "Select * from [sheet1$] where 姓名='" & xm & "'"
rst.Open sql, conn, adOpenKeyset, adLockOptimistic
rst.Update Array("性别", "年龄"), Array(xb, nl)
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
MsgBox "数据库的记录已修改"
End Sub
七、筛选记录
.Execute "Select 字段 from 表 where 条件"
下一课将详细讲解,暂不展开。
八、数据查找
数据库中查找记录可使用含 where 条件的 Select 语句,返回的可能是单条或多条记录。
例 6:在 Excel 数据库查找伍天明的记录
Sub 查找()
Set conn = CreateObject("adodb.connection")
Set rst = CreateObject("ADODB.recordset")
Dim data As New 数据库
conn.Open data.Excel数据库
rst.Open "select * from [Sheet1$] where 姓名='伍天明'", conn, adOpenKeyset, adLockOptimistic
If rst.RecordCount < 1 Then '记录集个数小于 1,表示未找到
MsgBox "找不到该姓名"
GoTo 100
End If
'找到则在立即窗口输出
Debug.Print "姓名:" & rst.Fields("姓名")
Debug.Print "年龄:" & rst.Fields("年龄")
Debug.Print "性别:" & rst.Fields("性别")
MsgBox "查找成功"
100:
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
End Sub

运行结果
例 7:在 Access 数据库查找伍天明的记录
Sub FindX()
Set conn = CreateObject("adodb.connection")
Set rst = CreateObject("ADODB.recordset")
Dim data As New 数据库
conn.Open data.Access数据库
rst.Open "select * from 员工 where 姓名='伍天明'", conn, adOpenKeyset, adLockOptimistic
If rst.RecordCount < 1 Then
MsgBox "找不到该姓名"
GoTo 100
End If
Debug.Print "姓名:" & rst.Fields("姓名")
Debug.Print "年龄:" & rst.Fields("年龄")
Debug.Print "性别:" & rst.Fields("性别")
MsgBox "查找成功"
100:
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
End Sub

Access 数据库仅有一条何靖的记录
九、在记录中循环
connect对象.BOF
表示记录集的最前端。
connect对象.EOF
表示记录集的末端。
GetRows(默认值-1, Start, 字段)
Start:0 从当前记录开始,1 从第一条记录开始,2 从最后一条记录开始。
例 8:在 Excel 数据库查找年龄大于 25 岁的记录
Sub 在记录之间循环()
Dim conn As New Connection
Dim rst As New Recordset
Dim data As New 数据库
Dim x
conn.Open data.Excel数据库
rst.Open "select * from [Sheet1$] where val(年龄)>25", conn, adOpenKeyset, adLockOptimistic
For x = 1 To rst.RecordCount '循环所有记录
If rst.EOF Then '如果循环到记录末尾
MsgBox "已到最后一条记录"
Else
Debug.Print rst.Fields("姓名") & rst.Fields("年龄")
rst.MoveNext '移动到下一条记录
End If
Next x
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
End Sub

运行结果
方法二:批量提取符合条件的记录,在数组中循环以提高速度
Sub 在记录之间循环2()
Dim conn As New Connection
Dim rst As New Recordset
Dim data As New 数据库
Dim x, arr, arr1
conn.Open data.Excel数据库
rst.Open "select * from [Sheet1$] where val(年龄)>25", conn, adOpenKeyset, adLockOptimistic
MsgBox rst.RecordCount
arr1 = Array("姓名", "年龄")
arr = Application.Transpose(rst.GetRows(-1, 1, arr1)) '将列数据转置为行
For x = 1 To UBound(arr, 1)
Debug.Print arr(x, 1) & "," & arr(x, 2)
Next x
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
End Sub
