VBA ADO Recordset .Copyfromrecordset 长时间运行

Question

我正在寻找可以修复此运行时构建的 VBA 代码，或有关可能导致此问题的建议。

我正在运行一个 VBA 脚本，该脚本使用 ADODB 从 SQL Server 数据库中检索数据。我已经在将数据复制到我的 Excel 工作表中的行上运行了运行时测试。运行时间是变化的；但是，我发现该行的运行时间在 3-30 秒之间:

Sheets(1).range("A8").CopyFromRecordset recordSet

记录集中的数据由 300 行和 13 列组成。

我觉得奇怪的一件事是，当 excel 应用程序关闭并重新打开时，运行时似乎重置为正常。

以下是对 .copyfromrecordset 行的每个测试的运行时概念:

测试 1:3 秒

测试 2:3 秒

测试 3:3 秒

测试 4:5 秒

测试 5:5 秒

测试 6:6 秒

测试 7:7 秒

测试 8:6 秒

测试 9:8 秒

测试 9:10 秒

...

测试 20:24 秒

我对本地命令进行了测试，例如格式化单元格宽度/高度，这些运行时间恒定为 1 或 2 秒。

也许我错误地使用了记录集，或者如果没有找到解决方案，我只会减少数据库调用，这会阻止我获得最新数据。

我已经检查并检查了我认为可能是问题的任何未关闭的记录集对象，但没有任何东西是打开的。

Function Query(SQL As String)

Dim recordSet As ADODB.recordSet
Dim Field As ADODB.Field
Set recordSet = New ADODB.recordSet
recordSet.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdTxt

If recordSet.State Then

    'seting up table headers
    Dim i As Integer
    For i = 0 To recordSet.Fields.Count - 1
    Sheets(1).Cells(7, 1 + i).value = recordSet.Fields(i).name
    Next i
    Sheets(1).range("A7:M7").Font.Bold = True

    t = Now()
    'insert recordset data into cells
    Sheets(1).range("A8").CopyFromRecordset recordSet
    MsgBox Format(Now() - t, "hh:mm:ss")**

    'close recordset object
    recordSet.Close
    Set recordSet = Nothing
End If


End Function

数据库连接

Function ConnectToDB(Server As String, Database As String) As Boolean

    Set Conn = New ADODB.Connection
    On Error Resume Next

    Conn.ConnectionString = "Provider=SQLOLEDB; Integrated Security=SSPI; Data Source=" & Server & "; Initial Catalog=" & Database & ";"
    Conn.Open

    If Conn.State = 0 Then
        ConnectToDB = False
    Else
        ConnectToDB = True
    End If

End Function

Answer 1

我遇到了同样的问题。通过一些代码一次单步执行一行，我隔离了 CopyFromRecordset 命令的两个实例，在处理具有大约 30K - 40K 记录的记录集时大约需要 5 - 6 分钟才能完成。这是一本包含许多公式的庞大工作簿。添加行:

Application.Calculation = xlManual

到宏开始将整个过程的时间从大约 10 - 12 分钟减少到只有 30 - 40 秒。

这可以防止 Excel 尝试重新计算大量工作簿中每个公式的值，并将数万条记录中的每条记录复制到工作表中。宏后面还有一行代码将行为恢复为默认值:

Application.Calculation = xlAutomatic