it-swarm.com.de

Verwenden von Excel VBA zum Exportieren von Daten in eine MS Access-Tabelle

Ich verwende derzeit folgenden Code, um Daten aus dem Arbeitsblatt in die MS Access-Datenbank zu exportieren. Der Code durchläuft jede Zeile und fügt Daten in die MS Access-Tabelle ein.

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

Der obige Code funktioniert gut für einige Hundert Zeilen Datensätze, aber anscheinend werden mehr Daten exportiert werden. Wie bei 25000 Datensätzen ist es möglich, das Exportieren ohne Durchlaufen aller Datensätze und nur eine SQL-Anweisung INSERT durchzuführen, um alle Daten in Ms.Access zu massen Tisch in einem Rutsch?

Jede Hilfe wird sehr geschätzt.

BEARBEITEN: AUSGESTELLT

Nur zur Information, wenn jemand danach sucht, habe ich eine Menge gesucht und festgestellt, dass der folgende Code für mich gut funktioniert, und er ist aufgrund von SQL INSERT sehr schnell (27648 Datensätze in nur 3 Sekunden!). ):

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

Sie arbeiten immer noch daran, einen bestimmten Feldnamen hinzuzufügen, anstatt "Select *" zu verwenden. Sie haben verschiedene Möglichkeiten zum Hinzufügen von Feldnamen versucht, können dies jedoch vorerst nicht funktionieren lassen.

19
Ahmed

ist es möglich, zu exportieren, ohne alle Datensätze zu durchlaufen

Bei einem Excel-Bereich mit einer großen Anzahl von Zeilen können Sie eine Leistungsverbesserung feststellen, wenn Sie ein Access.Application -Objekt in Excel erstellen und es dann zum Importieren der Excel-Daten in Access verwenden. Der folgende Code befindet sich in einem VBA-Modul in demselben Excel-Dokument, das die folgenden Testdaten enthält

SampleData.png

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
18
Gord Thompson

@Ammed

Nachfolgend finden Sie Code, der Felder aus einem benannten Bereich zum Einfügen in MS Access angibt. Das Schöne an diesem Code ist, dass Sie Ihre Felder in Excel nach Belieben benennen können (wenn Sie * verwenden, dann müssen die Felder genau zwischen Excel und Access übereinstimmen). obwohl die Access-Spalte "dte" genannt wird.

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
0
manofone