Update Access from Excel VBA - Very Slow

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

This answer may give you an idea: stackoverflow.com/questions/6574462/… — Demir
– Demir, Commented Sep 17, 2012 at 12:48

jpsfer · Accepted Answer · 2012-09-17 13:17:00Z

3

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,

edited Sep 17, 2012 at 13:17

answered Sep 17, 2012 at 12:50

jpsfer

5943 gold badges8 silver badges18 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

geebee Over a year ago

Thanks for your response. let me try these and get back with results

Collectives™ on Stack Overflow

Update Access from Excel VBA - Very Slow

1 Answer 1

1 Comment

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Your Answer

Sign up or log in

Post as a guest

Linked

Related