Jump to content


Check out our Community Blogs



Recent Status Updates

View All Updates

Developed by TechBiz Xccelerator
Photo
- - - - -

Writing the loop for updating multi-table MS access file using multi-sheet excel

vb

This topic has been archived. This means that you cannot reply to this topic.
No replies to this topic

#1 rela

rela

    CC Newcomer

  • Member
  • PipPip
  • 17 posts

Posted 15 November 2016 - 02:03 AM

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 tables as 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? 

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