2009年10月14日, 2:28 下午

Loading ...
如果要在Excel中处理数据库中的数据,则需要建立与数据库的连接。此时,可以使用连接字符串来同时设定多个属性,并以此字符串作为ADO Connection对象属性的值来建立连接。在《快速找到并输入连接数据源的字符串》一文中,我们介绍了方便找到连接字符串的一个技巧,下面主要介绍用于与常用数据库连接的连接字符串,以方便在程序中引用。
Access
Dim strConnect As String
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\MyDatabase.mdb;" & _
"User ID=UserName;" & _
"Password=password;"
(Access 2007)
Dim strConnect As String
strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\MyDatabase.accdb;" & _
"Mode=Share Exclusive;" & _
"User ID=UserName;" & _
"Password=password"
其中,参数Mode有三个最常用的设置,即adModeShareDenyNone,默认值,打开数据库并允许其他用户完全共享访问;adModeShareDenyWrite,打开数据库并允许其他用户读取访问但阻止写入访问;adModeShareExclusive,以独占模式打开数据库,阻止其他任何用户连接到此数据库。
SQL Server
(基本连接字符串)
Dim strConnect As String
strConnect = "Provider=SQLOLEDB;" & _
"Data Source=ServerName\InstanceName;" & _
"Initial Catalog=DatabaseName;"
(标准安全性类型的SQL Server连接字符串)
Dim strConnect As String
strConnect = "Provider=SQLOLEDB;" & _
"Data Source=ServerName\InstanceName;" & _
"Initial Catalog=DatabaseName;" & _
"User ID=UserName;" & _
"Password=password;"
(集成安全性类型的SQL Server连接字符串)
Dim strConnect As String
strConnect = "Provider=SQLOLEDB;" & _
"Data Source=ServerName\InstanceName;" & _
"Initial Catalog=DatabaseName;" & _
"Integrated Security=SSPI"
Excel
Dim strConnect As String
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\MyWorkbook.xls;" & _
"Extended Properties=""Excel 8.0;HDR=YES"";"
其中,HDR=YES表示数据中的第一行为列的名称,如果省略该参数或者HDR=No,那么将认为表格中是数据,没有列名。
(Excel 2007)
Dim strConnect As String
strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\MyWorkbook.xlsx;" & _
"Extended Properties=Excel 12.0;"
对于Excel 2007,参数Extended Properties设置为Excel 12.0,对于Excel 2007之前的版本,则设置为Excel 8.0。
默认情况下,假设表中第一行包含字段名称。如果第一行不包含字段名,则必须在参数Extended Properties中添加设置HDR=No,以避免丢失第一行数据。即:
"Extended Properties=""Excel 12.0;HDR=No"";"
文本文件
Dim strConnect As String
strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\Files\;" & _
"Extended Properties=Text;"
参数Data Source为包含文件的目录名,而不是文件名称。如果文本文件的第一行不包含字段名称,则必须在参数Extended Properties中参加HDR=No,以避免丢失第一行的数据。
使用连接字符串
可以将连接字符串赋值给ADO Connection对象的ConnectionString属性,或者直接将其传递给顶层ADO对象的相应属性和方法。
注意,在Excel VBA中使用ADO时,必须首先设置对Microsoft ActiveX ADO Objects 2.x对象库的引用。
示例:连接到Access数据库并打开
Public gcnAccess As ADODB.Connection
Sub OpenAccessConnection()
Dim strConnect As String
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=E:\MyDatabase.mdb;"
Set gcnAccess = New ADODB.Connection
gcnAccess.ConnectionString = strConnect
gcnAccess.Open
'操作数据库的代码
gcnAccess.Close
End Sub
连接到其它数据库的方式相同。
2009年07月11日, 2:21 下午

Loading ...
2009年06月10日, 12:40 下午

Loading ...
2009年06月8日, 9:22 下午

Loading ...
Excel擅长于分析数据,而Access则擅长于储存和整理数量较大且复杂的数据集,因此,将这两个应用软件协同使用,充分利用各自的优势,可以创建强大的数据处理工具。
使用VBA,能够在两个应用软件之间传递一条或多条记录,也能够通过Excel更新Access数据库。有两种主要的对象模型用于与Access相交互:DAO适用于处理Jet数据库引擎,而更新且更通用的ADO则适用于为企业级的数据库传递数据,例如SQL Server和Oracle。
在开始下面的内容之前,最好先下载示例文件,以便对照学习。
示例文件下载:人口预测.xls
示例文件说明
在示例文件中,“人口预测”工作表中1950年和2000年列是每个国家的实际人口,其它列是预测的人口,当单击“创建数据库”按钮时,会在与Excel文件相同的文件夹下创建一个名为“数据库测试.mdb”的Access数据库。该数据库包含一个带有7个字段的名为tblPopulation的表。当单击“装载到Access”按钮时,将装载工作表中所有记录到Access数据库的tblPopulation表。
“新字段”工作表中具有与“人口预测”工作表相同的人口数据,但增加了一个“区域”列。单击“插入字段”按钮,将添加“区域”字段到Access数据库的tblPopulation表;单击“更新字段数据”按钮,将更新Access表中的数据,即使用工作表列C中相匹配的数据更新数据库中新创建的区域字段的数据。单击“删除字段”按钮,将删除所创建的“区域”字段。
“下载表”工作表中,单击“下载表”按钮将使用数据库表tblPopulation中的数据填充该工作表;单击“更新当前记录”,如果您修改了当前行中的某个数据,那么修改将被写入到Access表中相应的记录。
“区域”工作表中,在单元格K1中具有数据有效性列表。从列表中选择一个值将触发事件代码,然后调用相应的代码模块下载该区域所有国家的数据到该工作表中。
“前20条”工作表中,单击“下载前20条记录”按钮,将数据表中前20条记录载入工作表中。
使用ADOX创建Access数据库和表
步骤1:设置合适的库引用
在VBE中,单击“工具——引用”,选择“Microsoft ActiveX Data Objects 2.X Library”和“Microsoft ADO Ext. 2.x for DDL And Security”。
步骤2:输入代码
在模块的声明部分,声明常量:
Const TARGET_DB = "数据库测试.mdb"
然后,输入下面的代码,以创建数据库。
Sub CreateDB_And_Table()
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim sDB_Path As String
sDB_Path = ActiveWorkbook.Path & Application.PathSeparator & TARGET_DB
'如果该数据库已存在则删除
On Error Resume Next
Kill sDB_Path
On Error GoTo 0
'创建新数据库
Set cat = New ADOX.Catalog
cat.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sDB_Path & ";"
'创建表
Set tbl = New ADOX.Table
tbl.Name = "tblPopulation"
tbl.Columns.Append "PopID", adInteger
tbl.Columns.Append "国家", adVarWChar, 60
tbl.Columns.Append "1950年", adDouble
tbl.Columns.Append "2000年", adDouble
tbl.Columns.Append "2015年", adDouble
tbl.Columns.Append "2025年", adDouble
tbl.Columns.Append "2050年", adDouble
cat.Tables.Append tbl
Set cat = Nothing
End Sub
步骤3:将CreateDB_And_Table过程关联到“创建数据库”按钮。
代码说明:上述代码首先创建一个新的Catalog,即使用ADOX引用数据库,然后创建一个名为tblPopulation的表,接着为该表添加字段,最后将该表添加到数据库中的Tables集合。
ADOX是ADO的扩展,可用来创建和修改数据库结构(表和字段),专门用来处理Jet数据库引擎。因此,使用ADOX来创建表和字段,并且很容易定义数据类型和索引值。
将工作表中的内容载入数据库表
要将工作表中的内容载入数据为表,需要完成下列步骤:
1、创建对数据库的连接。
2、定义基于表的记录集。
3、遍历列和行,一次装载一个字段数据到每条记录中。因此,对于每行,需要完成:
(1)rst.AddNew(创建一条新记录)
(2)遍历列,将值赋给记录集中的每个字段。本例中,工作表的列标题与数据库表的字段名完全相同,因此,载入数据时可以遍历标题以获取字段列表。
(3)rst.Update(保存记录)
4、最后,通过关闭Recordset和Connection对象然后将其设置为Nothing来完成清理,以避免内存泄漏。
代码如下:
Sub PushTableToAccess()
Dim cnn As ADODB.Connection
Dim MyConn
Dim rst As ADODB.Recordset
Dim i As Long, j As Long
Dim Rw As Long
'激活所需要的工作表,获取已使用的行数
Sheets("人口预测").Activate
Rw = Range("A65536").End(xlUp).Row
'创建对数据库的连接
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
End With
'创建记录集
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open Source:="tblPopulation", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
'将Excel中所有的记录载入Access.
For i = 2 To Rw
rst.AddNew
For j = 1 To 7
rst(Cells(1, j).Value) = Cells(i, j).Value
Next j
rst.Update
Next i
' 关闭连接并清理内存
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
在表中创建新字段并使用新数据更新现有的记录
下面,在现有的表中创建新字段,然后将数据载入到该字段而不影响其它字段。
1、添加新字段
(1)使用ADOX添加字段
按照下面的步骤使用ADOX创建新字段:
1)创建新的ADO连接
2)创建ADOX Catalog(数据库),使该数据库使用刚创建的ADO连接
3)设置对希望修改的表的引用
4)通过追加到该表的Columns集合,添加列到表中。在创建每个字段时,需要字义数据类型。
5)清理引用。
代码如下:
Sub AddNewField_ADOX()
Dim cnn As ADODB.Connection
Dim MyConn
Dim cat As ADOX.Catalog
Dim col As ADOX.Column
Dim tbl As ADOX.Table
Dim sDB_Path As String
MyConn = ActiveWorkbook.Path & Application.PathSeparator & TARGET_DB
'连接到数据库并使用该连接创建新的ADOX Catalog
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
End With
Set cat = New ADOX.Catalog
cat.ActiveConnection = cnn
'添加新字段
Set tbl = cat.Tables("tblPopulation")
tbl.Columns.Append "区域", adVarWChar, 60
'清理引用
Set cat = Nothing
Set col = Nothing
cnn.Close
Set cnn = Nothing
End Sub
(2)使用SQL添加字段
还有一种方法是使用SQL修改数据库和表结构,步骤如下:
1)创建新的ADO连接
2)创建Command对象,使其使用刚创建的ADO连接
3)执行添加新字段的SQL语句,在SQL语句中定义了字段类型和大小
4)清理引用
代码如下:
Sub AddNewField_SQL()
Dim cnn As ADODB.Connection
Dim cmd As ADODB.Command
Dim MyConn
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
'打开连接
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
End With
'创建新的Command对象,并设置其Connection属性
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = cnn
'创建字段
cmd.CommandText = "ALTER TABLE tblPopulation ADD Column 区域 Char(30)"
cmd.Execute
'清理引用
Set cmd = Nothing
cnn.Close
Set cnn = Nothing
End Sub
2、更新字段数据
要为多个记录更新字段的内容,需要遍历工作表中的行,一次修改一条记录,必须使用唯一的ID作为关键字段。步骤如下:
1)定位到正确的工作表,并确定需要载入多少行
2)创建ADO连接
3)遍历每条记录——定义当前记录中筛选过的记录集、打开记录集、修改记录、更新并关闭记录集
4)关闭连接并清理引用
代码如下:
Sub PopulateOneField()
Dim cnn As ADODB.Connection
Dim MyConn
Dim rst As ADODB.Recordset
Dim i As Long, j As Long
Dim Rw As Long
Dim sSQL As String
Sheets("新字段").Activate
Rw = Range("A65536").End(xlUp).Row
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
End With
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
'更新表中所有记录里的某字段
For i = 2 To Rw
sSQL = "SELECT * FROM tblPopulation WHERE PopID = " & Cells(i, 1).Value
rst.Open Source:=sSQL, ActiveConnection:=cnn, _
CursorType:=adOpenKeyset, LockType:=adLockOptimistic
rst(Cells(1, 3).Value) = Cells(i, 3).Value
rst.Update
rst.Close
Next i
' 关闭连接
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
将Access中表的内容下载到Excel
需要完成下列步骤:
(1)创建到数据库的ADO连接
(2)定义基于tblPopulation的记录集
(3)遍历表中的字段名称并将其写入工作表的第1行
(4)使用CopyFromRecordset方法将数据库记录传递到Excel,开始于第2行。CopyFromRecordset方法比一次遍历一条记录更有效,能够一次传递上千条记录。
(5)清理引用
代码如下:
Sub TransferTableFromAccess()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim fld As ADODB.Field
Dim MyConn
Dim i As Long
Dim ShDest As Worksheet
Set ShDest = Sheets("下载表")
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
End With
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open Source:="tblPopulation", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
'清除工作表中已存在的数据
ShDest.Activate
Range("A1").CurrentRegion.Offset(1, 0).Clear
'创建字段标题
i = 0
With Range("A1")
For Each fld In rst.Fields
.Offset(0, i).Value = fld.Name
i = i + 1
Next fld
End With
'将数据传递到Excel
Range("A2").CopyFromRecordset rst
' 关闭连接
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
使用数据有效性列表从Access查询中导入数据
在“区域”工作表模块中放置下列代码:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Target = Range("K1") Then Call DownloadRegion
Application.EnableEvents = True
End Sub
过程DownloadRegion的代码如下:
Sub DownloadRegion()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim fld As ADODB.Field
Dim MyConn
Dim i As Long
Dim ShDest As Worksheet
Dim sSQL As String
Set ShDest = Sheets("区域")
sSQL = "SELECT * FROM tblPopulation WHERE 区域 ='" & ShDest.Range("K1").Value & "'"
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
End With
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open Source:=sSQL, ActiveConnection:=cnn, _
CursorType:=adOpenForwardOnly, LockType:=adLockOptimistic, _
Options:=adCmdText
'清除工作表中已有的数据
ShDest.Activate
Range("A1").CurrentRegion.Clear
'创建字段标题
i = 0
With Range("A1")
For Each fld In rst.Fields
.Offset(0, i).Value = fld.Name
i = i + 1
Next fld
End With
'将数据传递到Excel
Range("A2").CopyFromRecordset rst
' 关闭连接
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
在Excel中编辑某条记录,并且更新Access表
按照下列步骤:
(1)查找当前行列A中的值,确定要更新的记录的ID。
(2)创建SQL语句,筛选表到要更新的记录。
(3)创建ADO连接,并且基于SQL语句打开记录集。
(4)遍历该行中的每一列,将值写入到该条记录。因为工作表第1行中标题与数据表中的字段名相匹配,所以可以遍历标题以识别要修改的字段。
(5)关闭记录集并清理引用。
代码如下:
Sub AlterOneRecord()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim fld As ADODB.Field
Dim MyConn
Dim lngRow As Long
Dim lngID As Long
Dim j As Long
Dim sSQL As String
'确定当前记录的ID并定义SQL语句
lngRow = ActiveCell.Row
lngID = Cells(lngRow, 1).Value
sSQL = "SELECT * FROM tblPopulation WHERE PopID = " & lngID
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
End With
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open Source:=sSQL, ActiveConnection:=cnn, _
CursorType:=adOpenKeyset, LockType:=adLockOptimistic
'将所有记录从Excel载入到Access.
For j = 2 To 7
rst(Cells(1, j).Value) = Cells(lngRow, j).Value
Next j
rst.Update
' 关闭连接
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
删除字段
1、使用ADOX删除字段
按照下列步骤:
(1)创建新的ADO连接。
(2)创建ADOX Catalog(数据库),并使该数据库使用刚创建的ADO连接。
(3)设置对希望修改的表的引用。
(4)通过表的Columns集合从表中删除列。
(5)清理引用。
注:要删除某字段,该字段首先必须已存在于表中。
代码如下:
Sub DeleteAField_ADOX()
Dim cnn As ADODB.Connection
Dim MyConn
Dim cat As ADOX.Catalog
Dim col As ADOX.Column
Dim tbl As ADOX.Table
MyConn = ActiveWorkbook.Path & Application.PathSeparator & TARGET_DB
'连接数据库
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
End With
Set cat = New ADOX.Catalog
cat.ActiveConnection = cnn
'删除列
Set tbl = cat.Tables("tblPopulation")
tbl.Columns.Delete "区域"
'清理引用
Set cat = Nothing
Set col = Nothing
cnn.Close
Set cnn = Nothing
End Sub
2、使用SQL删除字段
还有一种方法是使用SQL来删除字段。按照下列步骤:
(1)创建新的ADO连接。
(2)创建Command对象,使其使用新的ADO连接。
(3)执行SQL语句,使用DROP子句删除字段。
(4)清理引用。
代码如下:
Sub DeleteAField()
Dim cnn As ADODB.Connection
Dim cmd As ADODB.Command
Dim MyConn
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
'打开连接
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
End With
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = cnn
'删除字段
cmd.CommandText = "ALTER TABLE tblPopulation DROP Column 区域"
cmd.Execute
'清理引用
Set cmd = Nothing
cnn.Close
Set cnn = Nothing
End Sub
从数据库中提取指定数量的记录
从数据库表中获取前20条记录到工作表中的代码如下:
Sub DownloadTop20()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim fld As ADODB.Field
Dim MyConn
Dim i As Long
Dim ShDest As Worksheet
Dim sSQL As String
Set ShDest = Sheets("前20条")
sSQL = "SELECT * FROM tblPopulation WHERE PopID <= 20"
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
End With
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open Source:=sSQL, ActiveConnection:=cnn, _
CursorType:=adOpenForwardOnly, LockType:=adLockOptimistic, _
Options:=adCmdText
'清除工作表中已有的数据
ShDest.Activate
Range("A1").CurrentRegion.Offset(1, 0).Clear
'创建字段标题
i = 0
With Range("A1")
For Each fld In rst.Fields
.Offset(0, i).Value = fld.Name
i = i + 1
Next fld
End With
'将数据传递到Excel
Range("A2").CopyFromRecordset rst
' 关闭连接
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
(本文非常典型,清晰易懂,方便快速学习如何整合Excel与Access。本文整理自datawright.com.au,略有改动,有兴趣的朋友可以参考原文学习)