简体   繁体   English

导入Excel数据以通过Excel VBA进行访问

[英]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

When I tried exporting the data its giving me error in as: 当我尝试导出数据时,出现以下错误:

Error 3265. Item cannot be found in the collection. 错误3265。在集合中找不到项目。

I'm unable to export the data it's giving me error in the line 我无法导出该行中给我错误的数据

dbRecordset(Cells(1, xColumn).Value) = Cells(xRow, xColumn).Value

... Any Ideas ... 有任何想法吗

Instead of doing it like that. 而不是那样做。 Use docmd.transferSpreadsheet 使用docmd.transferSpreadsheet

One line will import the data into Access. 一行将数据导入Access。 You will need to add the reference Microsoft Access 14.0 Object Library to be able to use docmd . 您将需要添加参考Microsoft Access 14.0 Object Library才能使用docmd Or just run it from Access 或者只是从Access运行它

So it will be something like docmd.TransferSpreadsheet acExport,acSpreadsheetTypeExcel12, "AccessTableName", "FullFileName",true,"Range" 因此,它将类似于docmd.TransferSpreadsheet acExport,acSpreadsheetTypeExcel12, "AccessTableName", "FullFileName",true,"Range"

Replacing, AccessTablename with the name of the table you want to import to. AccessTablename替换为要导入到的表的名称。 FullFileName with the full file name of the excel sheet. FullFileName带有excel工作表的完整文件名。 Range with the range excel sheet. Range与范围Excel工作表相同。 You can remove range if you want to just copy all from Excel. 如果您只想从Excel复制所有内容,则可以删除range

EDIT. 编辑。 Updated to open Access 更新以打开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

This will open the Access DB. 这将打开Access DB。 Run the code and import the table. 运行代码并导入表。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM