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

Question

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

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表中？

任何帮助将不胜感激。

编辑：已解决的问题

只是为了如果有人试图对这个信息，我已经做了很多的搜索，发现下面的代码是做工精细对我来说，它是真正的快，由于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中，你可能会看到一些性能改进，如果你在Excel中创建一个Access.Application对象，然后用它来进口 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 

Answer 2

@Ahmed

在下面的代码是用于指定字段从命名区域，用于插入MS Access。这段代码的好处是你可以在Excel中命名你的字段，无论你想要什么（如果你使用*，那么这些字段必须完全匹配Excel和Access），你可以看到我已经命名为Excel列“哈哈”即使Access列被称为“dte”。

Sub test() 
    dbWb = Application.ActiveWorkbook.FullName 
    dsh = "[" & Application.ActiveSheet.Name & "$]" & "Data2" 'Data2 is a named range 


sdbpath = "C:\Users\myname\Desktop\Database2.mdb" 
sCommand = "INSERT INTO [main] ([dte], [test1], [values], [values2]) SELECT [haha],[test1],[values],[values2] FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh 

Dim dbCon As New ADODB.Connection 
Dim dbCommand As New ADODB.Command 

dbCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sdbpath & "; Jet OLEDB:Database Password=;" 
dbCommand.ActiveConnection = dbCon 

dbCommand.CommandText = sCommand 
dbCommand.Execute 

dbCon.Close 


End Sub