[英]Import Excel data to Access through Excel VBA
Sub AccImport()
Dim dbConnection As ADODB.Connection
Dim dbFileName As String
Dim dbRecordset As ADODB.Recordset
Dim xRow As Long, xColumn As Long
Dim LastRow As Long
'Go to the worksheet containing the records you want to transfer.
Worksheets("Completed").Activate
'Determine the last row of data based on column A.
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
'Create the connection to the database.
Set dbConnection = New ADODB.Connection
'Define the database file name
dbFileName = "C:/..."
'Define the Provider and open the connection.
With dbConnection
.Provider = "Microsoft.ACE.OLEDB.12.0;Data Source=" & dbFileName & _
";Persist Security Info=False;"
.Open dbFileName
End With
'Create the recordset
Set dbRecordset = New ADODB.Recordset
dbRecordset.CursorLocation = adUseServer
dbRecordset.Open Source:="Resolution", _
ActiveConnection:=dbConnection, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdTable
'Loop thru rows & columns to load records from Excel to Access.
'Assume row 1 is the header row, so start at row 2.
For xRow = 2 To LastRow
dbRecordset.AddNew
'Assume this is an 26-column (field) table starting with column A.
For xColumn = 1 To 26
dbRecordset(Cells(1, xColumn).Value) = Cells(xRow, xColumn).Value
Next xColumn
dbRecordset.Update
Next xRow
'Close the connections.
dbRecordset.Close
dbConnection.Close
'Release Object variable memory.
Set dbRecordset = Nothing
Set dbConnection = Nothing
'Optional:
'Clear the range of data (the records) you just transferred.
Range("A2:Z" & LastRow).ClearContents
End Sub
当我尝试导出数据时,出现以下错误:
错误3265。在集合中找不到项目。
我无法导出该行中给我错误的数据
dbRecordset(Cells(1, xColumn).Value) = Cells(xRow, xColumn).Value
... 有任何想法吗
而不是那样做。 使用docmd.transferSpreadsheet
一行将数据导入Access。 您将需要添加参考Microsoft Access 14.0 Object Library
才能使用docmd
。 或者只是从Access运行它
因此,它将类似于docmd.TransferSpreadsheet acExport,acSpreadsheetTypeExcel12, "AccessTableName", "FullFileName",true,"Range"
将AccessTablename
替换为要导入到的表的名称。 FullFileName
带有excel工作表的完整文件名。 Range
与范围Excel工作表相同。 如果您只想从Excel复制所有内容,则可以删除range
。
编辑。 更新以打开Access
Dim appAccess As Access.Application
Set appAccess = CreateObject("Access.Application")
appAccess.Visible = True
appAccess.OpenCurrentDatabase "FILENAME OF ACCESS DB"
appAccess.docmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "AccessTableName", "FullFileName", False
这将打开Access DB。 运行代码并导入表。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.