Export Excell Tabelle per VBA

Guten Morgen Zusammen,
Es geht um Berichte die täglich erstellt werden und als Ergebnistabellen in Excel erstellt werden. Da es täglich mehrere Dateien sind würde ich ungern für jede Datei Access öffnen und importieren wollen.
Daher habe ich gehofft es gibt eine Möglichkeit von Excel per VBA in eine bestehende Access Datenbank direkt zu exportieren. Dazu habe folgenden Code gefunden.
Hier ist der Bereich der Überschriften deklariert und die länge der Tabelle wird ermittelt. Das sieht ganz gut aus und beim Themenstarter hat es anscheinend funktioniert.. http://www.office-loesung.de/ftopic95185_0_0_asc.php
Wenn ich den Code ausführe erhalte ich den Fehler "Nicht erkennbares Datenbankformat"
Meine Access ist eine accdb Datei statt mdb.
Anpassungen in den Ranges und Pfad habe ich natürlich gemacht.
Kann jemand helfen?
Option Explicit


Sub TEST02_DB_import()
Dim ADOC As ADODB.Connection
Dim DBS As ADODB.Recordset
Dim lngZeile As Long, intIndex As Integer
Dim arNamen As Variant
On Error GoTo Fehler
Set ADOC = New ADODB.Connection
With ADOC
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open "e:\daten\excel\zahlen.mdb"
End With
Set DBS = New ADODB.Recordset
DBS.Open "Zahlen", ADOC, adOpenKeyset, adLockOptimistic
With Sheets("Importliste")
arNamen = .Range(.Range("A8"), .Range("A8").End(xlToRight))
For lngZeile = 9 To .Range("A9").End(xlDown).Row
DBS.AddNew
For intIndex = 1 To UBound(arNamen, 2)
DBS.Fields(arNamen(1, intIndex)) = .Cells(lngZeile, intIndex).Value
Next
DBS.Update
Next
End With
Fehler:
If Err.Number Then MsgBox Err.Description, , Err.Number
DBS.Close
ADOC.Close
Set ADOC = Nothing
Set DBS = Nothing
End 

Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ExcelToAccessAdo() Dim cn As ADODB.Connection, rs As ADODB.Recordset, row As Long Set cn = New ADODB.Connection cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _ "Data Source=h:\DatabaseExport.accdb;" ' open a recordset Set rs = New ADODB.Recordset rs.Open "GPR", cn, adOpenKeyset, adLockOptimistic, adCmdTable row = 2 ' the start row in the worksheet Do While Not IsEmpty(Worksheets(1).Range("A" & row)) With rs .AddNew ' create a new record .Fields("Voyage") = Worksheets(1).Range("A" & row).Value .Fields("Container") = Worksheets(1).Range("B" & row).Value .Fields("V/L") = Worksheets(1).Range("C" & row).Value .Fields("Standzeit VK") = Worksheets(1).Range("D" & row).Value .Fields("Standzeit EK") = Worksheets(1).Range("E" & row).Value .Update End With row = row + 1 Loop rs.Close Set rs = Nothing cn.Close Set cn = Nothing End Sub

Sub PushTableToAccess() On Error GoTo ErrorHandling Const TARGET_DB = "DatabaseExport.accdb" Dim cnn As ADODB.Connection Dim MyConn Dim rst As ADODB.Recordset Dim I As Long, j As Long Dim Rw As Long Sheets(1).Activate 'Replace the 'Sheet Name' with your Excel Sheet name Rw = Range("A65536").End(xlUp).Row Set cnn = New ADODB.Connection MyConn = "h:\DatabaseExport.accdb" With cnn .Provider = "Microsoft.ACE.OLEDB.12.0" .Open MyConn End With 'Replace the 'tblMyExcelUpload' with your table name in Access Set rst = New ADODB.Recordset rst.CursorLocation = adUseServer rst.Open Source:="GPR", ActiveConnection:=cnn, _ CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _ Options:=adCmdTable 'Load all records from Excel to Access. For I = 2 To Rw rst.AddNew For j = 1 To 114 rst(Cells(1, j).Value) = Cells(I, j).Value Next j rst.Update Next I ' Close the connection rst.Close cnn.Close Set rst = Nothing Set cnn = Nothing ErrorHandling: Select Case Err.Number Case 3265 Resume Next Case Else MsgBox "Fehler " & Err.Number & vbCrLf & Err.Description Resume Next End Select End Sub

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread