AW: Access Datenbank updaten mit Excel (ADO)
02.11.2011 21:00:57
Fettertiger
Hallo,
manchmal braucht man nur etwas Abstand dann sieht die Sache schon ganz anders aus.
Ich habe das alte "ADOFromExcelToAccess" kopiert und etwas mofifiziert und voila jetzt funzts einwandfrei:
Sub Update_Records_from_Excel_in_Access()
Dim filterstring As String
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
Dim DB_DatasourceString As String
Dim UpdateTime As Date
Dim Last_ConflictRow As Long
Dim Conflict As Boolean
DB_DatasourceString = "Data Source=" & tbl_data.Range("D5").Value & Chr(59)
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & DB_DatasourceString
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "FPC_TAB", cn, adOpenKeyset, adLockOptimistic, adCmdTable
r = 10 ' the start row in the worksheet
tbl_data.Unprotect
Do While Len(Range("B" & r).Formula) > 0 ' repeat until first empty cell in column B
filterstring = "autoid = " & Chr(39) & tbl_data.Range("G" & r).Value & Chr(39)
rs.Filter = filterstring
If rs.Fields("last_changed") > tbl_data.Range("F" & r).Value Then 'Access is newer
'conflict handling
Conflict = True
Last_ConflictRow = tbl_conflict.Cells(tbl_data.Rows.Count, 7).End(xlUp).Row
tbl_conflict.Range("B" & Last_ConflictRow + 1).Value = tbl_data.Range("b" & r). _
Value
tbl_conflict.Range("C" & Last_ConflictRow + 1).Value = tbl_data.Range("C" & r). _
Value
tbl_conflict.Range("d" & Last_ConflictRow + 1).Value = tbl_data.Range("d" & r). _
Value
tbl_conflict.Range("e" & Last_ConflictRow + 1).Value = tbl_data.Range("e" & r). _
Value
tbl_conflict.Range("f" & Last_ConflictRow + 1).Value = tbl_data.Range("f" & r). _
Value
tbl_conflict.Range("g" & Last_ConflictRow + 1).Value = tbl_data.Range("g" & r). _
Value
tbl_conflict.Range("h" & Last_ConflictRow + 1).Value = "Excel"
tbl_conflict.Range("B" & Last_ConflictRow + 2).Value = rs.Fields("FPC")
tbl_conflict.Range("C" & Last_ConflictRow + 2).Value = rs.Fields("Owner")
tbl_conflict.Range("d" & Last_ConflictRow + 2).Value = rs.Fields("X_Name")
tbl_conflict.Range("e" & Last_ConflictRow + 2).Value = rs.Fields("X_Number")
tbl_conflict.Range("f" & Last_ConflictRow + 2).Value = rs.Fields("last_changed")
tbl_conflict.Range("g" & Last_ConflictRow + 2).Value = rs.Fields("autoid")
tbl_conflict.Range("h" & Last_ConflictRow + 2).Value = "Access"
Else 'Access data is older
With rs
UpdateTime = Now
.Fields("FPC") = tbl_data.Range("B" & r).Value
.Fields("Owner") = tbl_data.Range("c" & r).Value
.Fields("X_Name") = tbl_data.Range("d" & r).Value
.Fields("X_Number") = tbl_data.Range("e" & r).Value
.Fields("last_changed") = UpdateTime
tbl_data.Cells(r, 6).Value = UpdateTime
' add more fields if necessary...
.Update ' stores the changed record
End With
End If
r = r + 1 ' next row
Loop
tbl_data.Protect
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
If Conflict = True Then
MsgBox ("There are datasets which have been updated in Access " & Chr(10) & _
"after your data was maintained in Excel")
tbl_conflict.Activate
End If
End Sub
Der Konflikte Tabelle habe ich dabei einen neuen Technischen Namen (tbl_conflict) gegeben um sie eleganter ansprechen zu können.
Trotzdem Danke an alle, die sich schon mit der Lösung beschäftigt haben.
Theo