使用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