[VBA] Creating record in Access DB from Excel VBA

skorpionkz

Well-known Member
Joined
Oct 1, 2013
Messages
1,168
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?

Code:
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.
 
Last edited:

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Watch MrExcel Video

Forum statistics

Threads
1,129,995
Messages
5,639,446
Members
417,090
Latest member
schoelleya

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top