Question

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

......任何想法

Answer 1

而不是那样做。使用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。

EDIT。已更新以打开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。运行代码并导入表。

通过Excel VBA将Excel数据导入Access

1 个答案: