偶遇到Excel向Access批量插入数据的题目，就做了一下总结。
ACCESS表
EXCEL表
要求：批量将Excel里的数据插入到Access对应的表格中。
addnew和update方法（循环）
Public Sub addnew和update方法()
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim mydata As String, myTable As String
Dim myFields As Variant, myValue As Variant
Dim arr
mydata = ThisWorkbook.Path & "\交叉录入.accdb" '指定数据库
myTable = "录入" '指定数据表名称
With cnn '建立与数据库的连接
.Provider = "microsoft.ace.oledb.12.0"
.Open mydata
End With
arr = [a11:d15]
'创建指定数据表的记录集
rs.Open myTable, cnn, adOpenKeyset, adLockOptimistic
'开始添加新记录
For i = 1 To UBound(arr) '添加数据
myFields = Array("款号", "颜色", "尺码", "数量")
myValues = Array(arr(i, 1), arr(i, 2), arr(i, 3), arr(i, 4))
With rs
.AddNew myFields, myValues
.Update
End With
Next
MsgBox "数据添加完毕！", vbInformation
'关闭记录集和数据库连接，释放变量
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub
insert方法（循环）
Public Sub insert方法()
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String
Dim arr
arr = [a11:d15].Value
'建立与建数据库的连接
With cnn
.Provider = "microsoft.ace.oledb.12.0;"
.Open ThisWorkbook.Path & "\交叉录入.accdb"
End With
'开始添加数据
For i = 1 To UBound(arr)
sr = "'" & arr(i, 1) & "','" & arr(i, 2) & "','" & arr(i, 3) & "','" & arr(i, 4) & "'"
SQL = "insert into 录入(款号,颜色,尺码,数量) values( " & sr & ")"
cnn.Execute SQL
Next
MsgBox "成功添加" & UBound(arr) & " 条记录！", vbInformation, "添加记录"
'释放变量
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub
insert into ...select方法
'//下面程序可插入超过65536行记录:
Sub 从Excel工作表中向数据表添加纪录()
Dim cnn As New ADODB.Connection
Dim myTable As String
myTable = "录入"
cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\交叉录入.accdb"
SQL = "INSERT INTO " & myTable & " SELECT * FROM [Excel 12.0;Database=" & ThisWorkbook.FullName & ";].[" & ActiveSheet.Name & "$a10:d15]"
cnn.Execute SQL
MsgBox "纪录添加成功。", vbInformation, "添加纪录"
cnn.Close
Set cnn = Nothing
End Sub
示例文件下载：
链接: http://pan.baidu.com/s/1o7PJjy6 密码: 7ixu
