sql - Excel VBA - 从 SQL/Recordset 写入数据非常慢

Question

我正在尝试将 SQL Server 数据写入 Excel 工作表，但速度很慢。有什么可以优化的吗？大约 20 个 cColumn 的 4000 个条目需要 6-7 分钟。

数据库（“freigabe”）模块：连接到数据库并获取 RecordSet（这就像一个魅力）

Private Function ConnectSQL() As ADODB.Connection
    Set conn = New ADODB.Connection
        conn.ConnectionString = "DRIVER={SQL Server};" _
            & "SERVER=xxxxx;" _
            & " DATABASE=xxxxx;" _
            & "UID=xxxxxx;PWD=xxxxx; OPTION=3"

        conn.Open

    Set ConnectSQL = conn
End Function

Public Function load(Optional ByVal FieldName As String = "", Optional ByVal fieldValue As String = "", Optional ByVal ComparisonOperator As String = "=")
'wenn fehler return?
'-> Über errorhandler retun rs oder boolen
    Dim rs As New ADODB.Recordset
    Dim sql As String
    Dim contition As String

    contition = " "

    Dim sqlfrom As String
    Dim sqlto As String


On Error GoTo Fehler:


    sql = "SELECT * FROM " & TBLNAME & " WHERE storno='0' AND created BETWEEN '2020-02-01' AND '2020-02-15'"

    Set conn = ConnectSQL()
        rs.Open sql, conn, adOpenStatic
    Set load = rs

    Exit Function
    End If
Fehler:
    load = Err.Description
End Function

获取/写入：建立连接并检索记录集。While循环需要很长时间。我正在跳过文本丰富的列（它变得更快但仍然太长）。显示一个加载窗口，这样人们就不会认为 Excel“不工作”。之后，数据得到验证（不包括在内）。

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim rs As Recordset
    Dim k As Integer
    Dim i As Integer

    Dim startt As Double
    Dim endt As Double

    Dim rngDst As Range

    Set rs = freigabe.load()


    Set rngDst = Worksheets("Freigaben").Range("G2")

    With Worksheets("Freigaben").Range("g2:Z50000")
        .ClearContents
        '.CopyFromRecordset rs
    End With
    Count = rs.RecordCount
    k = 0


    gui_laden.Show

    startt = Timer
    With rs
        If Not .BOF And Not .EOF Then
            .MoveLast
            .MoveFirst
            While Not .EOF
                For i = 0 To .Fields.Count - 1
                    If i <> 13 And i <> 2 And i <> 10 And i <> 5 And i <> 6 And i <> 0 Then  rngDst.Offset(, i) = .Fields(i).Value 'skip unneccessary data and write
                Next i
                k = k + 1
                Debug.Print k & "/" & Count
                gui_laden.lbl_status = "Lade Daten herunter: " & k & "/" & Count
                gui_laden.Repaint
                .MoveNext
                DoEvents 'Ensure Application doesn't freeze
                Set rngDst = rngDst.Offset(1)
            Wend
        End If
    End With

    endt = Timer - startt
    Debug.Print "Dauer: " & endt

我尝试了什么：

1. CopyFromRecordSet-> 应用程序冻结
2. 在新工作簿中测试 -> 相同

非常感谢！

标签： sqlexcelrecordset