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

我有一个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 并且在同步运行刷新脚本之前检查它们是否都已完成，因此它们重叠的几率大约为零，但是想先知道是否有更好的解决方案。

2480

2018-02-21 11:24

起源

写得好的问题+1

看看你的 Typical Expected debugger output:，如果 cnA 运行5秒然后第一个预期日志过去 Tables Cleared 应该是 Debug.Print "cnA records received: " & Now。你有 cnB records received 这有点误导根据你的逻辑。我注意到你说5秒，10秒，20秒，但根据预期应该是 cnA， cnB， cnC。你能详细说明一下吗？

@mehow估计数最多也是粗略的 - 最好忽略这些评论。查询的执行时间各不相同 - 在“大约5秒”的情况下，您可以将其表示为3秒到8之间的任何时间，“大约10秒”可能需要7秒到15秒。这完全有可能 cnB 完成之前 cnA，要么 cnC 完成之前 cnB （或者其他的东西真慢下来 cnA 和 cnC 在它之前完成） - 所有查询外部服务器意味着它完全依赖于网络，当前服务器负载，记录锁定等。 - Kai

谢谢你的澄清。我已经回答你，看看是否有帮助

答案:

我想我无法解释为什么你的'刷新脚本'并不总是激发。这是一种奇怪的行为，有时它们会运行，有时却不会运行。我无法真正看到您的整个脚本，但我可以告诉您我是如何采用您的代码的 每次都让它发挥作用。

注意：您的问题与某种程度上有关使用adAsyncExecute参数未触发ExecuteComplete ADODB Connection事件

我在我的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 和一些填充活动表格的代码 慢慢来。

现在，我可以运行不同的变化/配置。我可以旋转连接对象的执行时间。我可以有 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 根本没有执行。尝试对代码进行更改以反映我给您的代码并自行运行一些文本。我期待着您的反馈。

2018-02-24 13:25

有意思......我把代码改回了这种格式 _ExecuteComplete 需要一段时间才能完成，现在它似乎正如所宣传的那样工作（如果当前正在执行，则“排队”每个回调）。我会继续调试，看看是否再次出现问题。它可能是一个像失踪一样愚蠢的东西 Debug.Print 在我的一个 _ExecuteComplete这意味着我没有看到其中一个输出，或其他星期五下午WTF。让问题保持开放，直到我确信问题已经消失，如果是这样，我会接受这个答案。谢谢！ - Kai

@Kai我很高兴它能给你一些关于这个问题的见解。你能解释一下你的意思吗？ I changed my code back to this format where each _ExecuteComplete takes a while to complete？

当然。在我的问题中，每一个 _ExecuteComplete 由于刷新演示文稿表的代码，需要'x'秒才能完成。我认为这可能导致回调'掉线'，所以我删除了这段代码并用快速检查代替它以查看是否所有3 _ExecuteComplete 之后被调用然后做了刷新代码（txt.do/1gvj）。这使得每一个 _ExecuteComplete 几乎没有时间完成，所以我有99％的信心他们没有“重叠”。有点hacky，但它在当时似乎是一个不错的解决方案。 - Kai

@Kai对，我不想肯定地说这个，但我默默地认为你可能错过了 Debug.Print 在其中一个 _ExecuteComplete小号

这完全有可能 - Kai

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

我有一个评论。

这之间有一个重要的区别 ExecuteComplete 和 FetchComplete 事件。

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

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

2018-02-24 14:18

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

有时你的Recordset.Open或你的Command.Execute忽略了 AdAsynchFetch 参数。

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

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

Execute或Open方法同步运行 并填充一个记录。
该 ExecuteComplete 事件从未被提出过。

你可以看到我要去的地方......

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


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

用m_rst

    设置.ActiveConnection = ThisWorkbook.MyDBConnection

    .CursorType = adOpenForwardOnly

     Err.Clear
    。打开SQL ,,,, adCmdText + adAsyncFetch

结束

如果m_rst.State = adStateOpen那么

    '只有在忽略adAsyncFetch标志时才会运行此块
    如果m_rst.EOF和m_rst.BOF那么
        MsgPopup“没有匹配的数据”和“DATASET_NAME”，vbExclamation + vbOKOnly，“空数据集”，90
    ElseIf m_rst.EOF然后
        m_rst.MoveFirst
        m_rst_FetchComplete Nothing，GetStatus（m_rst），m_rst
    其他
        m_rst_FetchComplete Nothing，GetStatus（m_rst），m_rst
    万一

    设置m_rst = Nothing

ElseIf m_rst.ActiveConnection.Errors.Count＆GT 0然后

    m_rst_FetchComplete m_rst.ActiveConnection.Errors（0），adStatusErrorsOccurred，m_rst
    设置m_rst = Nothing

ElseIr Err.Number＆LT＆GT 0然后

    MsgPopup“Microsoft Excel返回错误＆H”＆Hex（Err.Number）＆“：”＆Err.Description，vbCritical + vbOKOnly，“请求错误”和DATASET_NAME，60
    设置m_rst = Nothing

ElseIf m_rst.State＆LT adStateOpen然后

    MsgPopup“Microsoft Excel无法请求”＆DATASET_NAME＆“的数据：没有错误信息可用”，vbCritical + vbOKOnly，“错误请求”＆DATASET_NAME，60
    设置m_rst = Nothing

其他

    '我正在使用的OLEDB驱动程序不支持获取progess
    'm_rst_FetchProgress 0,100，GetStatus（m_rst），m_rst

万一

显然，如果这样做，这将是无用的 _FetchComplete 永远不会引发事件：'open'以异步方式运行，并且该方法以状态adStateConnecting或adStateFetching中的记录集退出，并且您完全依赖于 m_rst_FetchComplete 事件程序。

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

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

也：

对于不熟悉ADODB编码的读者的提示：考虑使用 adCmdStoredProc 并按名称调用保存的查询或记录集返回函数，而不是使用“SELECT * FROM”和 adCmdText。

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

2017-10-08 10:10

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

答案:

热门问题

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