I imported the tables (DKt and DTt) from an ms access file to excel sheets (DKe and DTe) , each table corresponds to one sheet. Now I want to update the ms file, when some changes happen in excel file. I wrote different loops for different worksheets and tablesas shown in the code, but I have more than 8000 rows and it takes a long time to run. Is it the only way or there is another way to write the loop for all tables and worksheets? I also get an error, when I run the macro in a older version of microsoft (2013) for the line of lastrow = Workbooks(1).Sheet("DKe").Cells(Workbooks(1).Sheet("DKe").Rows.Count, "A").End(xlUp).Row
that Subscript out of range
, how can I get result with different version? Here is my macro for updating the tables in ms file from excel sheets:
`Sub UpdateMDB()
Dim accConn As Object, accRST As Object
Dim accFile As String, accStr As String
Dim lastrow As Long, i As Long
Const adOpenKeyset = 1, adLockOptimistic = 3, adCmdTableDirect = 512
Dim accConn2 As Object, accRST2 As Object, lastrow2 As Long
lastrow = Workbooks(1).Sheet("DKe").Cells(Workbooks(1).Sheet("DKe").Rows.Count, "A").End(xlUp).Row
''lastrow2 = Workbooks(1).Sheets("Dte").Cells(Workbooks(1).Sheets("DTe").Rows.Count, "A").End(xlUp).Row
accFile = "Z:\Documents\Database\Database1.mdb"
accStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & accFile & ";"
Set accConn = CreateObject("ADODB.Connection")
''Set accConn2 = CreateObject("ADODB.Connection")
Set accRST = CreateObject("ADODB.Recordset")
''Set accRST2 = CreateObject("ADODB.Recordset")
accConn.Open accStr
'' Update for DK
accRST.Open "SELECT * FROM DKt", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
If Not (accRST.BOF And accRST.EOF) Then
accRST.MoveFirst
Else
MsgBox "No records in Access table.", vbInformation
accRST.Close: accConn.Close: Set accRST = Nothing: Set accConn = Nothing
Exit Sub
End If
Do While Not accRST.EOF
For i = 1 To lastrow
If accRST!ID = Workbooks(1).Sheet("DKe").Range("A" & i) _
And accRST!DK <> Workbooks(1).Sheet("DKe").Range("B" & i) Then
accRST!DK.Value = Workbooks(1).Sheet("DKe").Range("B" & i)
End If
Next i
accRST.Update
accRST.MoveNext
Loop
accRST.Close: accConn.Close
Set accRST = Nothing: Set accConn = Nothing
'' Update for DT
''accRST2.Open "SELECT * FROM DTt", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
''If Not (accRST2.BOF And accRST2.EOF) Then
'' accRST2.MoveFirst
''Else
'' MsgBox "No records in Access table.", vbInformation
'' accRST2.Close: accConn.Close: Set accRST2 = Nothing: Set accConn = Nothing
'' Exit Sub
''End If
''Do While Not accRST2.EOF
'' For i = 1 To lastrow2
'' If accRST2!ID = Workbooks(1).Sheets("DTe").Range("A" & i) _
'' And accRST2!DT <> Workbooks(1).Sheets("DTe").Range("B" & i) Then
'' accRST2!DT.Value = Workbooks(1).Sheets("DTe").Range("B" & i)
'' End If
'' Next i
'' accRST2.Update
'' accRST2.MoveNext
''Loop
''accRST2.Close: accConn.Close
''Set accRST2 = Nothing: Set accConn = Nothing
End Sub
Looks like the problem starts in the line update for DK
. Can you try following? Or how did you solve it so far?
`accConn.Open accStr
accRST.Open "SELECT * FROM "DKt", accConn, adOpenKeyset, adLockOptimistic,
adCmdTableDirect
If Not (accRST.BOF And accRST.EOF) Then
accRST.MoveFirst
Else
MsgBox "No records in Access table.", vbInformation
accRST.Close: accConn.Close: Set accRST = Nothing: Set accConn = Nothing
Exit Sub
End If
For i = 2 To lastrow
If accRST!ID = Workbooks(1).Sheets("DKe").Range("A" & i) _
And accRST!DK <> Workbooks(1).Sheets("DKe").Range("B" & i) Then
accRST!DK.Value = Workbooks(1).Sheets("DKe").Range("B" & i)
accRST.Update
End If
accRST.MoveNext
Next i
accRST.Close: accConn.Close
Set accRST = Nothing: Set accConn = Nothing`
The part for update loop changes to
`accConn.Open accStr
accRST.Open "SELECT * FROM "DKt", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
If Not (accRST.BOF And accRST.EOF) Then
accRST.MoveFirst
Else
MsgBox "No records in Access table.", vbInformation
accRST.Close: accConn.Close: Set accRST = Nothing: Set accConn = Nothing
Exit Sub
End If
For i = 2 To lastrow
''(because in excel file the values start from second row and first row is name of the column)
If accRST!ID = Workbooks(1).Sheets("DKe").Range("A" & i) _
And accRST!DK <> Workbooks(1).Sheets("DKe").Range("B" & i) Then
accRST!DK.Value = Workbooks(1).Sheets("DKe").Range("B" & i)
accRST.Update
End If
accRST.MoveNext
Next i
accRST.Close: accConn.Close
Set accRST = Nothing: Set accConn = Nothing
MsgBox "DK was updated"`
and after that the next update for DT
starts with accConn2.Open accStr
.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.