Ich habe mal wieder ein Problem. Mit nachfolgendem Makro, das ich mal vor Jahren im Internet gefunden habe, aktualisiere ich in einer Accessdatenbank in einer Tabelle die Daten.
Sub Lagerbestand_ExportToAccess()
Const db_MDB As String = "Lager.mdb"
Const db_MDB_Sicher As String = "Sicherung_Lager.mdb"
Dim lngRow As Long
Dim rngBereichBlatt As Range
Dim rngBereichAccess As Range
Dim Verbindung_DB As ADODB.Connection
Dim objConn As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As New ADODB.Recordset
Dim riStartnummer As ADODB.Recordset
Dim catDB As New ADOX.Catalog
Dim Quelldatei As String
Dim Zieldatei As String
db_Path = "H:\.....\DB\"
On Error Resume Next
Kill (db_Path & db_MDB_Sicher)
Quelldatei = db_Path & db_MDB
Zieldatei = db_Path & db_MDB_Sicher
FileCopy Quelldatei, Zieldatei
On Error GoTo 0
On Error GoTo ERRORHANDLER
Export_läuft = True
'Wenn keine Teilnehmerdaten vorhanden, Prozedur beenden
If Lagerbestand.Range("A3") = "" Then Exit Sub
lngLastRow = Lagerbestand.Range("B65536").End(xlUp).Row
'Schriftfarbe der Spalte A auf blau umstellen
Lagerbestand.Range("A2:A" & lngLastRow).Font.ColorIndex = 5
'Tabellenbereich in der Exceltabelle'
Set rngBereichAccess = Lagerbestand.Range("A3:A" & lngLastRow)
''Verbindung zur DB
Set Verbindung_DB = New ADODB.Connection
With Verbindung_DB
.Provider = "Microsoft.Jet.OLEDB.4.0" + ";Jet OLEDB:Database Password="
.ConnectionString = "Data Source = " & db_Path & db_MDB
.Open
End With
rs.Open "Lagerbestand", Verbindung_DB, CursorType:=adOpenKeyset, LockType:=adLockOptimistic
For Each rngBereichBlatt In rngBereichAccess
'Erkennungszeichen für 1 gespeicherten DS in der Exceltabelle
If rngBereichBlatt.Font.ColorIndex = 5 Then 'blaue Schrift
iStartnummer = rngBereichBlatt.Value
'Suchvariable konfigurieren
iStartnummer = "[ID] = " & iStartnummer
'Suchen in der Accesstabelle
rs.Find iStartnummer
If (rs.BOF Or rs.EOF) Then
'DS nicht gefunden
rs.AddNew
ok = True
Else
ok = False
End If
'Daten nach Access übertragen
With rs
If ok Then
.Fields("ID").Value = rngBereichBlatt.Offset(0, 0).Value
End If
.Fields("Artikel_Nr").Value = rngBereichBlatt.Offset(0, 1).Value
.Fields("Artikelbezeichnung").Value = rngBereichBlatt.Offset(0, 2).Value
.Fields("Warenzustand").Value = rngBereichBlatt.Offset(0, 3).Value
.Fields("Lieferant").Value = rngBereichBlatt.Offset(0, 4).Value
.Fields("Besitzstand").Value = rngBereichBlatt.Offset(0, 5).Value
.Fields("Anzahl_Soll").Value = rngBereichBlatt.Offset(0, 6).Value
.Fields("Anzahl_Ist").Value = rngBereichBlatt.Offset(0, 7).Value
.Fields("Anzahl_Differenz").Value = rngBereichBlatt.Offset(0, 8).Value
.Fields("Auftrags_ID").Value = rngBereichBlatt.Offset(0, 9).Value
.Fields("Bearbeitet").Value = rngBereichBlatt.Offset(0, 10).Value
End With
rs.Update
End If
Next rngBereichBlatt
'alle Objekte-Variablen schließen bzw. Zeiger entfernen
rs.Close
Set rs = Nothing
Set cmd = Nothing
Verbindung_DB.Close
Set Verbindung_DB = Nothing
'Farbe Spalte "A" in Exceltabelle auf 'schwarz setzen
rngBereichAccess.Font.ColorIndex = 0
Set rngBereichAccess = Nothing
'Next iTabelle
'Variable auf False setzen, wird benötigt um beim Schließen festzustellen, dass eine _
Änderung an Datei durchgeführt wurde.
Export_läuft = False
'Prozedur beenden
Exit Sub
'Dieser Bereich wird abgearbeitet, sollte ein Fehler in Code auftreten. Dann erscheint eine _
Bildschirmmeldung
ERRORHANDLER:
On Error Resume Next
rs.Close
On Error GoTo 0
Set cmd = Nothing
Set catDB = Nothing
Verbindung_DB.Close
Set Verbindung_DB = Nothing
MsgBox "Auf Grund des aufgetretenen Fehlers wurde nicht alle Daten an die Datenbank übertragen. _
" _
& "Bitte starten Sie den Vorgang zum Übertragen der Daten durch Betätigen der " _
& " Schaltfläche" & vbLf & vbLf & """Daten an die Datenbank übertragen...""" & vbLf & _
vbLf _
& " erneut!", vbInformation, "Hinweis..."
End Sub
Nun ist das Problem, dass das mit einer .mdb Datei tadellos funktioniert. Nun wurde aber auf eine .accdb Accessdatenbank umgestellt und es funktioniert nicht mehr. Ich habe zwar in den Zeilen Const db_MDB As String = "Lager.mdb"
Const db_MDB_Sicher As String = "Sicherung_Lager.mdb"
die Endungen geändert, dann erscheint aber eine Meldung. Ich habe auch schon hier bei Herber und im Internet gesucht und habe herausgefunden, dass das Ansprechen einer accdb- Datenbank nicht mehr mit ADO, sondern mit DAO erfolgen muss, ich weiß leider nur nicht wie. Meine Versuche den DAO-Teil aus den gefundenen Codes bei mir zu integrieren sind klaglos gescheitert. Daher seid Ihr nun meine letzte Lösung. Ich hoffe, jemand weiß, was in dem Makro geändert werden muss, damit der Datenaustausch zwischen Excel und Access 2010 wieder funktioniert.
Danke Euch schon mal,
Kaismir