Daten aus Excel nach Access 2010 übertragen?

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