Excel VBA - Slow update of SQL Server table

Question

I am using this following VBA Code to export a range form my Excel worksheet to a SQL Server table (original source here)

Function ExportRangeToSQL(sourceRange As Range, conString As String, tableName As String) As Integer

    On Error Resume Next

    Dim con As Object
    Set con = CreateObject("ADODB.Connection")
    con.ConnectionString = conString
    con.Open

    Dim cmd As Object
    Set cmd = CreateObject("ADODB.Command")

    ' Do work within Transaction:'
    Dim level As Long
    level = con.BeginTrans

    cmd.CommandType = 1             ' adCmdText'

    Dim rst As Object
    Set rst = CreateObject("ADODB.Recordset")

    With rst

        ' Get Column Mapping Information from DB:'
        Set .ActiveConnection = con
        .Source = "SELECT TOP 1 * FROM " & tableName
        .CursorLocation = 3         ' adUseClient'
        .LockType = 4               ' adLockBatchOptimistic'
        .CursorType = 0             ' adOpenForwardOnly'
        .Open

        ' Column mappings'
        Dim tableFields(100) As Integer
        Dim rangeFields(100) As Integer

        Dim exportFieldsCount As Integer
        exportFieldsCount = 0

        Dim col As Integer
        Dim index As Integer

        ' Map range Columns to DB Columns:'
        For col = 0 To .Fields.Count - 1
            index = Application.Match(.Fields(col).Name, sourceRange.Rows(1), 0)
            If index > 0 Then
                exportFieldsCount = exportFieldsCount + 1
                tableFields(exportFieldsCount) = col
                rangeFields(exportFieldsCount) = index
            End If
        Next

        If exportFieldsCount = 0 Then
            ExportRangeToSQL = 1
            GoTo ConnectionEnd
        End If


        ' Load the Range into the Recordset:'
        Dim arr As Variant
        arr = sourceRange.Value

        Dim row As Long
        Dim rowCount As Long
        rowCount = UBound(arr, 1)

        Dim val As Variant

        For row = 2 To rowCount
            .AddNew
            For col = 1 To exportFieldsCount
                val = arr(row, rangeFields(col))
                If IsEmpty(val) Then
                Else
                    .Fields(tableFields(col)) = val
                End If
            Next
        Next


        ' Update the table using the same RecordSet:'
        .UpdateBatch
    End With

    rst.Close
    Set rst = Nothing

    ExportRangeToSQL = 0

ConnectionEnd:

    con.CommitTrans

    con.Close
    Set cmd = Nothing
    Set con = Nothing

End Function

Basically, it:

1. Creates a recordset based upon the table we wish to update
2. Maps each column of your update range to a field in the recordset
3. Updates the recordset with the data to be uploaded
4. Uses Recordset.UpdateBatch to update the table all at once.

I'm finding, though, that this is INCREDIBLY slow (for 1000-2000 records) and writing separate insert statements to be substantially faster (albeit not as pretty).

Any thoughts on how to make this faster?

Answer 1

Please change this line of code:

.CursorType = 0             ' adOpenForwardOnly'

to

.CursorType = 4             ' adOpenStatic - could also use adOpenKeyset

as your cursor type is not optimised for update operations.

See the MSDN Reference on this