如何将多个excel工作簿导入 access

Question

如题所述

Answer 1

Sub 添加记录access2007()
Dim cnn As New ADODB.Connection
Dim Cat As New ADOX.Catalog
Dim MyData$, MyFile, n%
MyData = ThisWorkbook.Path & "\数据库.accdb"
On Error Resume Next
If Dir(MyData) = "" Then
Cat.Create "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & MyData
Else
Cat.ActiveConnection = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & MyData
Cat.Tables.Delete "数据表1"
End If
Set Cat = Nothing
On Error GoTo 0
cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & MyData
Mypath = ThisWorkbook.Path & "\"
MyFile = Dir(Mypath & "*.xlsx")
Do While MyFile <> ""
n = n + 1
If n = 1 Then
cnn.Execute "select * into 数据表1 from [Excel 12.0;Database=" & Mypath & MyFile & "].[Sheet1$]"
Else
cnn.Execute "insert into 数据表1 select * from [Excel 12.0;Database=" & Mypath & MyFile & "].[Sheet1$]"
End If
MyFile = Dir()
Loop
cnn.Close
Set cnn = Nothing
MsgBox "ok"
End Sub