VBA to insert many records into access DB fast

Question

OK so I have a spreadsheet that produces a reasonably large amount of records (~3500)

I have the following script that inserts them into my access db:

Sub putinDB()
Dim Cn As ADODB.Connection, Rs As ADODB.Recordset
Dim MyConn, sSQL As String

Dim Rw As Long, c As Long
Dim MyField, Result
Dim x As Integer
Dim accName As String, AccNum As String, sector As String, holding As String,  holdingvalue As Double, holdingdate As Date
theend = lastRow("Holdings", 1) - 1
'Set source
MyConn = "S:\Docs\Harry\Engine Client\Engine3.accdb"
'Create query
Set r = Sheets("Holdings").Range("a2")
x = 0
Do
Application.StatusBar = "Inserting record " & x + 1 & " of " & theend
accName = r.Offset(x, 0)
AccNum = r.Offset(x, 4)
sector = r.Offset(x, 2)
holding = r.Offset(x, 1)
holdingvalue = r.Offset(x, 3)
holdingdate = r.Offset(x, 5)

sSQL = "INSERT INTO Holdings (AccName, AccNum, Sector, Holding, HoldingValue, HoldingDate)"
sSQL = sSQL & " VALUES ('" & Replace(accName, "'", "''") & "', '" & AccNum & "', '" & sector & "', '" & Replace(holding, "'", "''") & "', '" & holdingvalue & "', #" & holdingdate & "#)"
Debug.Print (sSQL)
 'Create RecordSet
Set Cn = New ADODB.Connection
With Cn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .CursorLocation = adUseClient
    .Open MyConn
    Set Rs = .Execute(sSQL)
End With
x = x + 1
Loop While r.Offset(x, 0) <> "" Or x < 15
Application.StatusBar = False
End Sub

The trouble is, is that it loops through each record one-by-one, rebuilds and executes the query each time which results in very slow execution (about 2-3 records per second on my PC)

Is there a way to have vba insert the whole range into the DB in one go without having to loop through? Thanks

Solution 1

OK, silly me. After a bit of tinkering it turns out that putting the

Set Cn = New ADODB.Connection
With Cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.CursorLocation = adUseClient
.Open MyConn
End With

bit outside the loop makes it far quicker.

Solution 2

The answer you have provided should improve things slightly as you only need open the connection once, but the code is still inefficient. You really only want to write to your recordset once with all the data rather than like this. I always prefer working from the Access side to pull info from Excel as oppose to pushing into Access from Excel but I believe we can use either for this scenario.

In this case your better to use DAO over ADO and work with a Transacation, essentially you still loop over the recordset but the actual act of writing the data does not happen until you Commit at the end so it's much faster.

This is a very basic example from the Access side for you to try:

Private Sub TestTrans()

Dim wksp    As DAO.Workspace
Dim rs      As DAO.Recordset

    Set wksp = DBEngine.Workspaces(0) 'The current database

    wksp.BeginTrans 'Start the transaction buffer

    Set rs = CurrentDb.OpenRecordset("Table1", dbOpenDynaset)

    Do 'Begin your loop here

    With rs
        .AddNew
            !Field = "Sample Data"
        .Update
    End With

    Loop 'End it here

    wksp.CommitTrans 'Commit the transaction to dataset

End Sub

Comments

[harryg]

Thanks for the suggestion. Moving the connection bit outside the loop actually shortens the execution time from over 20 minutes to around 20 secs so it's a massive improvement. This is a script that should only really need to be run once a month so it doesn't need to be maximally efficient, but if I get a bit of extra time I'll try that method.

[Matt Donnan]

Wow, that makes a far bigger difference than I would have guessed, 20 seconds probably isn't worth the recode time then, but if you ever find yourself with 10's of thousands of lines or more to import then it would be worth it.

[harryg]

Yeah that's what I though. I guess we will end up with many more records but hopefully by that time computing power will make it insignificant