Excel VBA - SQL Server 表更新缓慢

Question

我正在使用以下 VBA 代码将我的 Excel 工作表中的范围导出到 SQL Server 表 (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

基本上，它：

1. 根据我们希望更新的表创建记录集
2. 将更新范围的每一列映射到记录集中的一个字段
3. 使用要上传的数据更新记录集
4. 使用Recordset.UpdateBatch 一次性更新表。

不过，我发现这非常慢（对于 1000-2000 条记录），并且编写单独的插入语句要快得多（尽管不那么漂亮）。

关于如何使这更快的任何想法？

Answer 1

请更改这行代码：

.CursorType = 0             ' adOpenForwardOnly'

到

.CursorType = 4             ' adOpenStatic - could also use adOpenKeyset

因为您的游标类型未针对更新操作进行优化。

见MSDN Reference on this