在VBA中插入查询

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中Tools/References下的参考。使用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