Update Access from Excel VBA - Very Slow - vba

Question

I have the below piece of code to append new data to an existing Access table.
It takes around 35-40 minutes for me to upload about 6000 records...
Appreciate any help...
Sub Upload(Process_ID)
Dim Conn_DB As ADODB.Connection, CmdQuery As ADODB.Command, RecSet As ADODB.Recordset, StrSQL As String
Dim LastColumn As Integer, LastRow As Integer, ImportData(), I As Integer, ArrayRow As Integer
WS_Source.Select
LastRow = WS_Source.Cells(Rows.Count, 1).End(xlUp).Row
LastColumn = WS_Source.Cells(1, Columns.Count).End(xlToLeft).Column
'Load source data to array
ReDim ImportData(LastRow - 2, 25)
Select Case Process_ID
Case 1, 2, 3
For I = 2 To LastRow
ImportData(ArrayRow, 0) = Cells(I, 1) 'username
ImportData(ArrayRow, 1) = Cells(I, 2) 'creid
ImportData(ArrayRow, 2) = Cells(I, 3) 'roleid
ImportData(ArrayRow, 3) = Cells(I, 4) 'webtraceid
ImportData(ArrayRow, 4) = Cells(I, 5) 'timestamp
ImportData(ArrayRow, 5) = Cells(I, 6) 'action
ImportData(ArrayRow, 6) = Cells(I, 7) 'Anti Fact
ImportData(ArrayRow, 7) = Cells(I, 8) 'sourceid
ImportData(ArrayRow, 8) = Cells(I, 9) 'source
ImportData(ArrayRow, 9) = Cells(I, 10) 'personid
ImportData(ArrayRow, 10) = Cells(I, 11) 'personname
ImportData(ArrayRow, 11) = Cells(I, 12) 'orgid
ImportData(ArrayRow, 12) = Cells(I, 13) 'orgname
ImportData(ArrayRow, 13) = Cells(I, 14) 'rel type
ImportData(ArrayRow, 14) = Cells(I, 15) 'oldvalue
ImportData(ArrayRow, 15) = Cells(I, 16) 'new value
ImportData(ArrayRow, 16) = Cells(I, 17) 'startdate
ImportData(ArrayRow, 17) = Cells(I, 18) 'enddate
ImportData(ArrayRow, 18) = Cells(I, 19) 'status
ImportData(ArrayRow, 19) = Cells(I, 20) 'sourcetype
ImportData(ArrayRow, 20) = Cells(I, 21) 'final score
ImportData(ArrayRow, 21) = Cells(I, 22) 'ben
ImportData(ArrayRow, 22) = Cells(I, 23) 'wpc
ImportData(ArrayRow, 23) = Cells(I, 24) 'prw
ImportData(ArrayRow, 24) = Cells(I, 26) 'serial
ImportData(ArrayRow, 25) = Cells(I, 28) 'sample
ArrayRow = ArrayRow + 1
Next I
Case Else: Exit Sub
End Select
'Load array data to database
Set Conn_DB = New ADODB.Connection
With Conn_DB
.Provider = "microsoft.ACE.OLEDB.12.0"
.ConnectionString = Location_DataBase
End With
Conn_DB.Open
StrSQL = "SELECT *"
Set CmdQuery = New ADODB.Command
With CmdQuery
.ActiveConnection = Conn_DB
.CommandText = StrSQL
.CommandType = adCmdText
End With
For I = 0 To ArrayRow - 1
Set RecSet = New ADODB.Recordset
With RecSet
Set .Source = CmdQuery
.CursorType = adOpenKeyset
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open "tbl_crereport"
End With
If RecSet.State = adStateOpen Then
With RecSet
.AddNew
Select Case Process_ID
Case 1, 2, 3
.Fields("processedby") = ImportData(I, 0)
.Fields("creid") = ImportData(I, 1)
.Fields("roleid") = ImportData(I, 2)
.Fields("webtraceid") = ImportData(I, 3)
.Fields("processeddate") = ImportData(I, 4)
.Fields("action") = ImportData(I, 5)
.Fields("antifact") = ImportData(I, 6)
.Fields("sourceid") = ImportData(I, 7)
.Fields("source") = ImportData(I, 8)
.Fields("personid") = ImportData(I, 9)
.Fields("personname") = ImportData(I, 10)
.Fields("orgid") = ImportData(I, 11)
.Fields("orgname") = ImportData(I, 12)
.Fields("relationshiptype") = ImportData(I, 13)
.Fields("oldvalue") = ImportData(I, 14)
.Fields("newvalue") = ImportData(I, 15)
.Fields("startdate") = ImportData(I, 16)
.Fields("enddate") = ImportData(I, 17)
.Fields("crestatus") = ImportData(I, 18)
.Fields("sourcetype") = ImportData(I, 19)
.Fields("finalscore") = ImportData(I, 20)
.Fields("ben") = ImportData(I, 21)
.Fields("wpc") = ImportData(I, 22)
.Fields("prw") = ImportData(I, 23)
.Fields("Serial") = ImportData(I, 24)
.Fields("sample") = ImportData(I, 25)
.Fields("allocatedto") = User_ID
.Fields("allocationdate") = Now()
.Fields("updatedby") = User_ID
.Fields("updatedate") = Now()
.Fields("status") = 1
Case Else: Exit Sub
End Select
.Update
End With
End If
RecSet.Close
Set RecSet = Nothing
Next I
'Close database
On Error Resume Next
RecSet.Close
Conn_DB.Close
Set CmdQuery = Nothing
Set RecSet = Nothing
Set Conn_DB = Nothing
End Sub
Appreciate any help to speedup the code.
I'd not be able to use this at the current speed.
Thanks,
g

Answer 1

3 small tips:
if you have indexes in Access the append/update can become significantly slower than you would expect. You might want to remove these indexes while data is being added.
have you tried writing the VBA in Access instead? That way you could import the Excel file in bulk, do the necessary data manipulation and load it into the table you need in one go (not record by record).
My VBA might be rusty but I think you don't have to create a recordset per new record you are appending. Create it once before the cycle and just don't close it until all records are loaded in.
Regards,