sql - 使用 Excel VBA 将数据导出到 MS Access 表

Question

我目前正在使用以下代码将数据从工作表导出到 MS Access 数据库，代码循环遍历每一行并将数据插入到 MS Access 表中。

Public Sub TransData()

Application.ScreenUpdating = False
Application.EnableAnimations = False
Application.EnableEvents = False
Application.DisplayAlerts = False

ActiveWorkbook.Worksheets("Folio_Data_original").Activate

Call MakeConnection("fdMasterTemp")

For i = 1 To rcount - 1
    rs.AddNew
    rs.Fields("fdName") = Cells(i + 1, 1).Value
    rs.Fields("fdDate") = Cells(i + 1, 2).Value
    rs.Update

Next i

Call CloseConnection

Application.ScreenUpdating = True
Application.EnableAnimations = True
Application.EnableEvents = True
Application.DisplayAlerts = True

End Sub

Public Function MakeConnection(TableName As String) As Boolean
'*********Routine to establish connection with database

   Dim DBFullName As String
   Dim cs As String

   DBFullName = Application.ActiveWorkbook.Path & "\FDData.mdb"

   cs = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"

   Set cn = CreateObject("ADODB.Connection")

   If Not (cn.State = adStateOpen) Then
      cn.Open cs
   End If

   Set rs = CreateObject("ADODB.Recordset")

   If Not (rs.State = adStateOpen) Then
       rs.Open TableName, cn, adOpenKeyset, adLockOptimistic
   End If

End Function

Public Function CloseConnection() As Boolean
'*********Routine to close connection with database

On Error Resume Next
   If Not rs Is Nothing Then
       rs.Close
   End If


   If Not cn Is Nothing Then
       cn.Close
   End If
   CloseConnection = True
   Exit Function

End Function

上面的代码适用于几百行记录，但显然它会导出更多数据，比如 25000 条记录，是否可以在不循环所有记录的情况下导出，只需一条 SQL INSERT 语句即可将所有数据批量插入 Ms.Access一口气上 table ？

任何帮助都感激不尽。

编辑:问题已解决

仅供引用，如果有人寻求此信息，我进行了大量搜索，发现以下代码对我来说可以正常工作，并且由于 SQL INSERT，它真的很快，(27648 条记录只需 3 秒!!!! ):

Public Sub DoTrans()

  Set cn = CreateObject("ADODB.Connection")
  dbPath = Application.ActiveWorkbook.Path & "\FDData.mdb"
  dbWb = Application.ActiveWorkbook.FullName
  dbWs = Application.ActiveSheet.Name
  scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
  dsh = "[" & Application.ActiveSheet.Name & "$]"
  cn.Open scn

  ssql = "INSERT INTO fdFolio ([fdName], [fdOne], [fdTwo]) "
  ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh

  cn.Execute ssql

End Sub

仍在努力添加特定的字段名称而不是使用“Select *”，尝试了各种方法来添加字段名称，但现在无法使其工作。

Answer 1

is it possible to export without looping through all records

对于 Excel 中具有大量行的范围，如果您创建 Access.Application，您可能会看到一些性能改进。 Excel 中的对象，然后使用它将 Excel 数据导入 Access。下面的代码位于同一 Excel 文档中的 VBA 模块中，其中包含以下测试数据

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