excelvbaperformancems-accesssql-update

How to speed up the tranfer of information between Excel and Access?

I am having problems with updating records in MS Access through Excel macro (coded in VBA).

I'll try to explain better what's the issue:

I created a UserForm to input the information inserted in several ListBoxes (populated by strings) into an MS Access database. The 1st loop is checking if each element of the ListBox1 is already present in the database and, if it's not, it's inserting it in. The elements from the ListBox2 could either be the same or differ from the one from the 1st. Therefore, I am performing the "Access.Application.DCount" to avoid errors related to duplicate entries. Always in the 2nd loop, if the element has already been inserted in the database, I just run an "UPDATE" query to check a CheckBox; if the element is not found in the database, I run the "INSERT INTO" query to create the new record.

The issue I am experiencing is that - since the loops are running one right after the other - MS Access is taking a long time to update the entries (around 5 seconds). Thus - when the 2nd loop runs - only the "INSERT INTO" query is executed, even if the elements are exactly the same as the ones inserted in the 1st loop. This explains is the reason of the following lines of code:

'Wait for the database to update
cnt.Update
Application.Wait Now + #12:00:05 AM#

If I wait those 5 seconds before running the 2nd loop, then the elements from the 1st loop are recorded in the database and I have no problems with the 2nd loop. However, I cannot afford to waste all this time waiting for the MS Access to refresh. I need to run several couples of similar loops, and the waiting time is extending too far.

Is there a way to optimise my code and/or to speed up the information tranfer between Excel and Access?

I am pasting the 2 loops here:

For X = 0 To ListBox1.ListCount - 1
    'Look for duplicates
    If ((Access.Application.DCount("*", "Table1", "ID ='" & IdentificationCode & "' AND DWG = '" & ListBox1.List(X) & "'") > 0) Or IsNull(ListBox1.List(X)) = True) Then
        'MsgBox "Element already in the DB"
    Else
        On Error Resume Next
        
        'Insert the data into the recordset
        insert1 = "insert into Table1(" _
        & "ID," _
        & "DWG," _
        & "CheckBox1)" _
        & "values(" _
        & "'" & IdentificationCode & "'," _
        & "'" & ListBox1.List(X) & "'," _
        & "-1)"
        
        cnt.Execute (insert1)
    End If
Next X

If (ListBox2.ListCount > 0) Then
    'Wait for the database to update
    cnt.Update
    Application.Wait Now + #12:00:05 AM#

    For X = 0 To ListBox2.ListCount - 1
        'Look for duplicates
        If ((Access.Application.DCount("*", "Table1", "ID ='" & IdentificationCode & "' AND DWG = '" & ListBox2.List(X) & "'") > 0)) Then 'Or IsNull(ListBox2.List(X)) = True)
            'MsgBox "Element already in the DB"
            On Error Resume Next
            
            update1 = "update Table1 set" _
            & "[Table2].CheckBox2 ='-1'" _
            & "where [Table2].ID ='" & IdentificationCode & "'" _
            & "and [Table2].DWG ='" & ListBox2.List(X) & "';"
            
            cnt.Execute (update1)
        Else
            On Error Resume Next
            
            'Insert the data into the recordset
            insert2 = "insert into Table1(" _
            & "ID," _
            & "DWG," _
            & "CheckBox2)" _
            & "values(" _
            & "'" & IdentificationCode & "'," _
            & "'" & ListBox2.List(X) & "'," _
            & "-1)"
            
            cnt.Execute (insert2)
        End If
    Next X
End If

Obviously, this is not the full code. Before getting to the loops I am setting the "ADODB.Connection" and opening it.

I would like to underline the fact that this code returns no error. It is doing what is supposed to do. My question here is what can I do to avoid waiting those 5 seconds?

Thank you in advance for your time and support! Hope you can help me with that.

Solution

  • You can skip DCount and the call for an update/insert for each listbox entry: