VBA 中的 INSERT INTO 查询

Question

我使用的是 Access 2013 和 Excel 2013。在参考方面，我使用的是 Microsoft Office 15.0 Access 数据库引擎对象库。

所以我试图从 VBA 运行 INSERT INTO 查询。工作表有一个零件编号列表，我使用此代码将其转换为数组。

Function partArray()
    Dim partList() As Variant
    Dim partArr(10000) As Variant
    Dim x As Long

    partList = ActiveWorkbook.Worksheets("Parts").ListObjects("Parts").ListColumns("Part Number").DataBodyRange.Value

    For x = LBound(partList) To UBound(partList)
        partArr(x) = partList(x, 1)
    Next x

    partArray = partArr

End Function

现在我正在尝试使用 INSERT INTO 查询将这些部件号输入到访问表中。知道我该怎么做吗？

Answer 1

您应该使用 ADO 在 Excel 和 Access 之间进行连接。它将是 VBE 中工具/参考下的参考。使用 ADO，您可以运行 SQL 语句。您可以将 Excel 中的表定义为原始表，然后从中读取数据，将它们放入记录集，然后将记录集写入 Access 表。网上有很多例子。你可以从这个开始：https://www.exceltip.com/import-and-export-in-vba/export-data-from-excel-to-access-ado-using-vba-in-microsoft-excel.html

Answer 2

哇！我认为你的方法是完全错误的。试试这样的。

Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=C:\FolderName\DataBaseName.mdb;"
    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable  
    ' all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

或者，这个。

Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
    Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb") 
    ' open the database
    Set rs = db.OpenRecordset("TableName", dbOpenTable) 
    ' get all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub

如果您愿意，当然可以使用 TransferSpreadsheet 方法。

Option Explicit

Sub AccImport()
    Dim acc As New Access.Application
    acc.OpenCurrentDatabase "C:\Users\Public\Database1.accdb"
    acc.DoCmd.TransferSpreadsheet _
            TransferType:=acImport, _
            SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
            TableName:="tblExcelImport", _
            Filename:=Application.ActiveWorkbook.FullName, _
            HasFieldNames:=True, _
            Range:="Folio_Data_original$A1:B10"
    acc.CloseCurrentDatabase
    acc.Quit
    Set acc = Nothing
End Sub