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、レコードのように、することが可能ですすべてのレコードと1つのSQL INSERT文をループせずにエクスポートすると、すべてのデータを一度にMs.Access Tableに一括挿入できますか？

ご協力いただければ幸いです。

EDIT：問題はただ、誰もがこのために求めている場合については、私は、検索をたくさん行って、私のために仕事の罰金であることを、次のコードを発見し、それが原因に速い本当できた

を解決しましたSQLのINSERT、（わずか3秒で27648件のレコードが!!!!）：

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 

それでも特定のフィールドを追加する作業は、「*選択」使用するのではなく、名前のフィールド名を追加するさまざまな方法を試してみましたが、作ることができませんそれは今のところうまくいく。 ExcelでAccess.Applicationオブジェクトを作成し、Accessに輸入にExcelデータを、それを使用する場合は、いくつかのパフォーマンスの向上が表示されることがあり、多数の行とExcelの範囲については

Answer 1

is it possible to export without looping through all records

。以下のコードは、次の試験データ

以下

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

を含む同じExcelドキュメント内のVBAモジュールにあるに挿入するための名前付き範囲からフィールドを指定するコードでありますMSアクセス。このコードの素晴らしい点は、Excelの列に「Haha」という名前が付けられていることが分かるように、Excelでフィールドを名前を付けて指定できることです（*を使用すると、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