Używanie Excel VBA do eksportowania danych do tabeli MS Access

Question

Obecnie używam następującego kodu do eksportu danych z arkusza roboczego do bazy danych MS Access, kod przechodzi przez każdy wiersz i wstawia dane do tabeli 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 

Powyższy kod działa dobrze dla kilkuset wierszy rekordów, ale najwyraźniej to będzie więcej danych na eksport, jak 25000 rekordów, możliwe jest eksportuj bez przechodzenia przez wszystkie rekordy i jedną instrukcję SQL INSERT, aby zbiorczo wstawić wszystkie dane do tabeli Ms.Access za jednym razem?

Każda pomoc będzie doceniana.

EDIT: problem został rozwiązany

Tylko dla informacji, jeśli ktoś dąży do tego, zrobiłem mnóstwo wyszukiwania i znaleźć następujący kod za pracę w porządku dla mnie, i to bardzo szybko ze względu na SQL INSERT (27648 rekordy w ciągu zaledwie 3 sekund !!!!):

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 

Wciąż pracuje, aby dodać określone pola nazwa zamiast używać „Select *”, próbowali różnych sposobów dodawania nazwy pól, ale nie może zrobić to działa na razie.

Answer 1

is it possible to export without looping through all records

Dla zakresu programu Excel z wielu wierszy można zauważyć pewną poprawę wydajności jeśli utworzyć Access.Application obiektu w programie Excel, a następnie użyć go do importu dane programu Excel do programu Access. Poniższy kod jest w module VBA w tym samym dokumencie Excel, który zawiera następujące dane testowe

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

Poniżej jest kod, który określa pola z nazwanego zakresu do wkładania MS Access. Zaletą tego kodu jest to, że możesz nazwać swoje pola w Excelu bez względu na to, do czego chcesz (Jeśli użyjesz *, pola muszą dokładnie odpowiadać między Excelem a Access), jak widzisz, nazwałem kolumnę Excela "Haha" mimo że kolumna Access nazywa się "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