Question

我有一个Excel工作簿，它向数据库发出三个查询以填充隐藏工作表上的三个表，然后运行三个“刷新”脚本将这些数据拉到三个可见的演示文稿表（每个查询一个）。同步运行这个很慢：刷新的总时间是三个查询中每个查询的时间总和加上每个“刷新”脚本运行的时间总和。

我知道VBA不是多线程的，但我认为可以通过异步触发查询来加快速度（从而允许在执行时进行一些清理工作）），然后在数据返回时为每个工作表执行填充/刷新工作。

我重写了我的脚本如下（注意我必须删除连接字符串，查询字符串等并使变量通用）：

Private WithEvents cnA As ADODB.Connection
Private WithEvents cnB As ADODB.Connection
Private WithEvents cnC As ADODB.Connection

Private Sub StartingPoint()
    'For brevity, only listing set-up of cnA here. You can assume identical
    'set-up for cnB and cnC
    Set cnA = New ADODB.Connection

    Dim connectionString As String: connectionString = "<my conn string>"
    cnA.connectionString = connectionString

    Debug.Print "Firing cnA query: " & Now
    cnA.Open
    cnA.Execute "<select query>", adAsyncExecute  'takes roughly 5 seconds to execute

    Debug.Print "Firing cnB query: " & Now
    cnB.Open
    cnB.Execute "<select query>", adAsyncExecute  'takes roughly 10 seconds to execute

    Debug.Print "Firing cnC query: " & Now
    cnC.Open
    cnC.Execute "<select query>", adAsyncExecute  'takes roughly 20 seconds to execute

    Debug.Print "Clearing workbook tables: " & Now
    ClearAllTables
    TablesCleared = True
    Debug.Print "Tables cleared: " & Now
End Sub

Private Sub cnA_ExecuteComplete(ByVal RecordsAffected As Long, ...)
    Debug.Print "cnA records received: " & Now
    'Code to handle the recordset, refresh the relevant presentation sheet here, 
    'takes roughly < 1 seconds to complete
    Debug.Print "Sheet1 tables received: " & Now
End Sub

Private Sub cnB_ExecuteComplete(ByVal RecordsAffected As Long, ...)
    Debug.Print "cnB records received: " & Now
    'Code to handle the recordset, refresh the relevant presentation sheet here, 
    'takes roughly 2-3 seconds to complete
    Debug.Print "Sheet2 tables received: " & Now
End Sub

Private Sub cnC_ExecuteComplete(ByVal RecordsAffected As Long, ...)
    Debug.Print "cnC records received: " & Now
    'Code to handle the recordset, refresh the relevant presentation sheet here, 
    'takes roughly 5-7 seconds to complete
    Debug.Print "Sheet3 tables received: " & Now
End Sub

典型的预期调试器输出：

Firing cnA query: 21/02/2014 10:34:22
Firing cnB query: 21/02/2014 10:34:22
Firing cnC query: 21/02/2014 10:34:22
Clearing tables: 21/02/2014 10:34:22
Tables cleared: 21/02/2014 10:34:22
cnB records received: 21/02/2014 10:34:26
Sheet2 tables refreshed: 21/02/2014 10:34:27
cnA records received: 21/02/2014 10:34:28
Sheet1 tables refreshed: 21/02/2014 10:34:28
cnC records received: 21/02/2014 10:34:34
Sheet3 tables refreshed: 21/02/2014 10:34:40

当然，三个查询可以以不同的顺序返回，具体取决于哪个完成，所以有时典型的输出的排序方式不同 - 这是预期的。

但有时候，cnX_ExecuteComplete回调中的一个或两个根本不会发射。经过一段时间的调试，我很确定这样做的原因是，如果一个记录集在其中一个回调当前正在执行时返回，则不会发生调用。例如：

查询A，B和C全部在时间0点火
查询A在时间3完成，cnA_ExecuteComplete触发
查询B在时间5
cnA_ExecuteComplete仍在投放，因此cnB_ExecuteComplete永远不会触发
cnA_ExecuteComplete在时间8完成
查询C在时间10完成，cnC_ExecuteComplete触发
查询C在时间15完成

我的理论是否正确，这是问题所在？如果是这样，是否可以解决这个问题，或者在当前代码执行之前接受“等待”调用而不是仅仅消失？

一种解决方案是在cnX_ExecuteComplete回调期间非常快速地执行某些操作（例如，单行Set sheet1RS = pRecordset并检查是否在完成同步运行刷新脚本之前完成了所有操作因此，它们重叠的几率几乎为零，但想先知道是否有更好的解决方案。

Answer 1

我想我无法解释为什么有些'刷新脚本'并不总是会触发。这是一种奇怪的行为，有时它们会运行，有时却不会运行。我无法真正看到您的整个脚本，但我可以向您展示我是如何采用您的代码并且每次都使用它。

注意：您的问题与ExecuteComplete ADODB Connection event not fired with adAsyncExecute parameter

有某种关联

我在SQL服务器上添加了3个存储过程; sp_WaitFor5，sp_WaitFor10，sp_WaitFor20来模拟查询执行时间的延迟。

就像

一样简单

CREATE PROCEDURE sp_WaitFor5
AS
WAITFOR DELAY '00:00:05'

所有3个延迟。

然后在我的 Module1 中添加了一个非常简单的代码来调用自定义类

Option Explicit

Private clsTest As TestEvents

Sub Main()
    Cells.ClearContents
    Set clsTest = New TestEvents
    Call clsTest.StartingPoint
End Sub

然后我将类模块重命名为 TestEvents 并添加了稍微修改过的代码版本

Option Explicit

Private WithEvents cnA As ADODB.Connection
Private WithEvents cnB As ADODB.Connection
Private WithEvents cnC As ADODB.Connection

Private i as Long

Public Sub StartingPoint()

    Dim connectionString As String: connectionString = "Driver={SQL Server};Server=MYSERVER\INST; UID=username; PWD=password!"

    Debug.Print "Firing cnA query(10 sec): " & Now
    Set cnA = New ADODB.Connection
    cnA.connectionString = connectionString
    cnA.Open
    cnA.Execute "sp_WaitFor10", adExecuteNoRecords, adAsyncExecute

    Debug.Print "Firing cnB query(5 sec): " & Now
    Set cnB = New ADODB.Connection
    cnB.connectionString = connectionString
    cnB.Open
    cnB.Execute "sp_WaitFor5", adExecuteNoRecords, adAsyncExecute

    Debug.Print "Firing cnC query(20 sec): " & Now
    Set cnC = New ADODB.Connection
    cnC.connectionString = connectionString
    cnC.Open
    cnC.Execute "sp_WaitFor20", adExecuteNoRecords, adAsyncExecute

End Sub


Private Sub cnA_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
    Debug.Print vbTab & "cnA_executeComplete START", Now
    For i = 1 To 55
        Range("A" & i) = Rnd(1)
    Next i
    Debug.Print vbTab & "cnA_executeComplete ENDED", Now
End Sub

Private Sub cnB_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
    Debug.Print vbTab & "cnB_executeComplete START", Now
    For i = 1 To 1000000
        Range("B" & i) = Rnd(1)
    Next i
    Debug.Print vbTab & "cnB_executeComplete ENDED", Now
End Sub

Private Sub cnC_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
    Debug.Print vbTab & "cnC_executeComplete START", Now
    For i = 1 To 55
        Range("C" & i) = Rnd(1)
    Next i
    Debug.Print vbTab & "cnC_executeComplete ENDED", Now
End Sub

除了Execute的{{3}}和一些填充活动表只需花费时间的代码之外，我的确没有太多变化。

现在，我可以运行不同的变体/配置。我可以旋转连接对象的执行时间。我可以cnA 5秒，cnB 10秒，cnC 20秒。我可以交换/调整每个_ExecuteComplete事件的执行时间。

从我自己的测试中我可以向你保证，所有3个始终执行。

以下是基于与您类似的配置的一些日志

Firing cnA query(10 sec): 24/02/2014 12:59:46
Firing cnB query(5 sec): 24/02/2014 12:59:46
Firing cnC query(20 sec): 24/02/2014 12:59:46
    cnB_executeComplete START             24/02/2014 12:59:51 
    cnB_executeComplete ENDED             24/02/2014 13:00:21 
    cnA_executeComplete START             24/02/2014 13:00:21 
    cnA_executeComplete ENDED             24/02/2014 13:00:21 
    cnC_executeComplete START             24/02/2014 13:00:22 
    cnC_executeComplete ENDED             24/02/2014 13:00:22

在上面的示例中，您可以看到，所有3个查询都是异步触发的。

cnA在5秒后返回句柄，这使得cnB第一个让事件（'刷新脚本'）在层次结构中运行cnC花费的时间最长。

由于cnB 首先返回，它会触发cnB_ExecuteComplete事件过程。 cnB_ExecuteComplete本身设置需要花费一些时间执行（迭代100万次并用随机数填充B列。注意：cnA填充A列，cnB col B，cnC col C）。查看上面的日志需要30秒才能运行。

当cnB_ExecuteComplete正在执行其工作/占用资源（并且您知道VBA是单线程）时，cnA_ExecuteComplete事件将添加到TODO的队列中流程。所以，你可以把它想象成一个队列。当事情正在被照顾下一件事时，必须等到最后。

如果我更改配置; cnA 5秒，cnB 10秒，cnC 20秒，让每个'刷新脚本'迭代100万次

Firing cnA query(5 sec): 24/02/2014 13:17:10
Firing cnB query(10 sec): 24/02/2014 13:17:10
Firing cnC query(20 sec): 24/02/2014 13:17:10
one million iterations each
    cnA_executeComplete START             24/02/2014 13:17:15 
    cnA_executeComplete ENDED             24/02/2014 13:17:45 
    cnB_executeComplete START             24/02/2014 13:17:45 
    cnB_executeComplete ENDED             24/02/2014 13:18:14 
    cnC_executeComplete START             24/02/2014 13:18:14 
    cnC_executeComplete ENDED             24/02/2014 13:18:44

从第一个例子中明确证明了我的观点。

此外，尝试cnA 5秒，cnB 5秒，cnC 5秒

Firing cnA query(5 sec): 24/02/2014 13:20:56
Firing cnB query(5 sec): 24/02/2014 13:20:56
Firing cnC query(5 sec): 24/02/2014 13:20:56
one million iterations each
    cnB_executeComplete START             24/02/2014 13:21:01 
    cnB_executeComplete ENDED             24/02/2014 13:21:31 
    cnA_executeComplete START             24/02/2014 13:21:31 
    cnA_executeComplete ENDED             24/02/2014 13:22:01 
    cnC_executeComplete START             24/02/2014 13:22:01 
    cnC_executeComplete ENDED             24/02/2014 13:22:31

其中也完成/执行所有3。

就像我说的，我看不到你的整个代码，也许你的代码中某处有一个未处理的错误，也许有些误导你认为一个_ExecuteComplete根本没有执行。尝试更改您的代码以反映我给您的代码并自行运行一些文本。我期待着您的反馈。

Answer 2

我也不确定为什么事件并不总是被你解雇对我来说，测试始终有效（测试了10万行和14列），但我不确定您的数据库的大小和您正在执行的查询的复杂性。

虽然我有一个评论。

ExecuteComplete和FetchComplete事件之间存在重要差异。

命令执行完毕后会发出ExecuteComplete（在您的示例中，命令对象由ADO内部创建）。这并不一定意味着在此回调触发时已获取所有记录。

因此，如果您需要使用返回的记录集，则应该监听fetchComplete回调，该回调仅在完全提取记录集时触发。

Answer 3

我可以给你一个答案，它可以帮助你一些时间，但不是所有时间。

有时，您的Recordset.Open或Command.Execute会忽略AdAsynchFetch参数。

也就是说：当您请求时，问题立即显现，并且当ADODB使用已填充的记录集回调时，应用程序处于无响应状态时不会出现问题。

幸运的是，这是你可以在代码中捕获的东西;当忽略AdFetchAsynch时会发生三件事：

Execute或Open方法同步运行并填充a 记录即可。
永远不会引发ExecuteComplete事件。

你可以看到我的目标......

如果您的记录集请求代码在退出之前检测到打开的记录集，请将打开的记录集直接传递到现有的_FetchComplete事件过程中：


Set m_rst = New ADODB.Recordset  ' declared at module level With Events

With m_rst

    Set .ActiveConnection = ThisWorkbook.MyDBConnection

    .CursorType = adOpenForwardOnly

     Err.Clear
    .Open SQL, , , , adCmdText + adAsyncFetch

End With

If m_rst.State = adStateOpen Then

    ' This block will only run if the adAsyncFetch flag is ignored
    If m_rst.EOF And m_rst.BOF Then
        MsgPopup "No matching data for " & DATASET_NAME, vbExclamation + vbOKOnly, "Empty data set", 90
    ElseIf m_rst.EOF Then
        m_rst.MoveFirst
        m_rst_FetchComplete Nothing, GetStatus(m_rst), m_rst
    Else
        m_rst_FetchComplete Nothing, GetStatus(m_rst), m_rst
    End If

    Set m_rst = Nothing

ElseIf m_rst.ActiveConnection.Errors.Count > 0 Then

    m_rst_FetchComplete m_rst.ActiveConnection.Errors(0), adStatusErrorsOccurred, m_rst
    Set m_rst = Nothing

ElseIf Err.Number <> 0 Then

    MsgPopup "Microsoft Excel returned error &H" & Hex(Err.Number) & ": " & Err.Description, vbCritical + vbOKOnly, "Error requesting " & DATASET_NAME, 60
    Set m_rst = Nothing

ElseIf m_rst.State < adStateOpen Then

    MsgPopup "Microsoft Excel was unable to request data for " & DATASET_NAME & ": no error information is available", vbCritical + vbOKOnly, "Error requesting " & DATASET_NAME, 60
    Set m_rst = Nothing

Else

    ' Fetch progess is not available with the OLEDB driver I am using
    ' m_rst_FetchProgress 0, 100, GetStatus(m_rst), m_rst

End If

如果永远不会提出_FetchComplete事件，显然这将毫无用处：＆＃39; open＆＃39;异步运行并且该方法以状态adStateConnecting或adStateFetching中的记录集退出，并且您完全依赖于m_rst_FetchComplete事件过程。

但这在某些时候解决了这个问题。

下一步：当您在以太网中输出记录集请求时，您需要检查Application.EnableEvents是否永远不会设置为false。我猜你已经想到了这一点，但这是我能想到的唯一一件事。

此外：

对于不熟悉ADODB编码的读者的提示：请考虑使用adCmdStoredProc并按名称调用已保存的查询或记录集返回功能，而不是使用＆＃39; SELECT * FROM＆＃39;和adCmdText。

这里的答案很晚，但其他人也会遇到同样的问题。

使用ADODB运行多个异步查询 - 回调并不总是触发

3 个答案: