[VBA] Creating record in Access DB from Excel VBA

[skorpionkz]

Hi guys,

I have code that loops through the records (class objects in dictionary) and adding them to the Access database.
My understanding is that you can't add 2 dimensional array to the Access Table and need to add them 1 by 1.

Previously my table was in .csv file and it took about 3-4 seconds to update this table, but once I moved this to the Access it takes about 5 minutes.

I will paste the code I am using for creating the records, but first I will explain steps code doing prior to it.

I have tracker sent by another team, which cannot be uploaded directly to DB.
I have macro that runs through the tracker do some analyses and creates class objects.
Macro then remove all records from database and loop dictionary of objects and add each item to DB

Is there any way to make "Creating Records" faster or yet adding 2 dimensional array?

Public Function CreatingRecord(ByVal str_Table As String, ByVal str_Headers As String, ByRef arr_Values() As Variant) As Long


    Dim myConnection            As ADODB.Connection
    Dim myCommand               As New ADODB.Command
    Dim sSQL                    As String
    
    Dim str_Values As String
    Dim i As Integer
    
    If UBound(arr_Values, 1) < 1 Then Exit Function
    
    On Error GoTo CreateRecordErrorHandler
    
    Set myConnection = ConnectTo_IPSDB
    
    ' CREATE RECORD BODY
    For i = 1 To UBound(arr_Values, 1)
        If i = 1 Then
            str_Values = "p" & i
        Else
            str_Values = str_Values & ",p" & i
        End If
    Next i


    sSQL = "INSERT INTO " & str_Table & " (" _
    & str_Headers & _
    ") VALUES (" _
    & str_Values & ")"
    
    With myCommand
        .ActiveConnection = myConnection
        .CommandType = adCmdText
        .Prepared = True
            For i = 1 To UBound(arr_Values, 1)
               .Parameters.Append .CreateParameter("p" & i, adBSTR, adParamInput, , arr_Values(i))
            Next i
         'Debug.Print sSQL
        .CommandText = sSQL
        .Execute
    End With
    
    ' CREATE RECORD END
     
    CreatingRecord = myConnection.Execute("SELECT @@Identity", , adCmdText).Fields(0).value 'FIND ID NUMBER OF ADDED ELEMENT
        
    myConnection.Close
    
    Set myConnection = Nothing
    
    On Error GoTo 0
    Exit Function
CreateRecordErrorHandler:


    MsgBox "An Error has occured" & vbCrLf & vbCrLf & Err.Description, vbCritical, "Databse Error"
    'Debug.Print sSQL
    Err.Clear
End Function

Thank you.