简体   繁体   中英

Updating multi-table MS access file using multi-sheet excel

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM