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

Running multiple async queries with ADODB - callbacks not always firing

提问by Kai

I have an Excel workbook that fires three queries to a database to populate three tables on hidden sheets, and then runs three 'refresh' scripts to pull this data through to three visible presentation sheets (one per query). Running this synchronously is quite slow: The total time to refresh is the sum of the time of each of the three queries, plus the sum of the time for each 'refresh' script to run.

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

I'm aware that VBA isn't multi-threaded, but I thought it would be possible to speed things up a bit by firing the queries off asynchronously (thus allowing some clean-up work to be done whilst they were executing), and then doing the population / refresh work for each sheet as the data comes back.

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

I rewrote my script as follows (note that I've had to remove the connection strings, query strings etc and make the variables generic):

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

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

Typical expected debugger output:

典型的预期调试器输出：

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

The three queries can come back in different orders depending on which finishes first, of course, so sometimes the typical output is ordered differently - this is expected.

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

Sometimes however, one or two of the cnX_ExecuteCompletecallbacks don't fire at all. After some time debugging, I'm fairly certain the reason for this is that if a recordset returns whilst one of the callbacks is currently executing, the call does not occur. For example:

然而，有时，一两个cnX_ExecuteComplete回调根本不会触发。经过一段时间的调试，我相当肯定这是因为如果记录集在其中一个回调当前正在执行时返回，则不会发生调用。例如：

• query A, B and C all fire at time 0
• query A completes first at time 3, cnA_ExecuteCompletefires
• query B completes second at time 5
• cnA_ExecuteCompleteis still running, so cnB_ExecuteCompletenever fires
• cnA_ExecuteCompletecompletes at time 8
• query C completes at time 10, cnC_ExecuteCompletefires
• query C completes at time 15

• 查询 A、B 和 C 都在时间 0 触发
• 查询 A 在时间 3 首先完成，cnA_ExecuteComplete触发
• 查询 B 在时间 5 完成秒
• cnA_ExecuteComplete仍在运行，所以cnB_ExecuteComplete永远不会触发
• cnA_ExecuteComplete在时间 8 完成
• 查询 C 在时间 10 完成，cnC_ExecuteComplete触发
• 查询 C 在时间 15 完成

Am I right in my theory that this is the issue? If so, is it possible to work around this, or get the call to 'wait' until current code has executed rather than just disappearing?

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

One solution would be to do something extremely quick during the cnX_ExecuteCompletecallbacks (eg, a one-liner Set sheet1RS = pRecordsetand a check to see if they're all done yet before running the refresh scripts synchronously) so the chance of them overlapping is about zero, but want to know if there's a better solution first.

一种解决方案是在cnX_ExecuteComplete回调期间做一些非常快的事情（例如，Set sheet1RS = pRecordset在同步运行刷新脚本之前检查它们是否都已完成），因此它们重叠的可能性大约为零，但想要首先要知道是否有更好的解决方案。

采纳答案by Kai

I guess I am not able to explain why some your 'refresh scripts' don't always fire. It's a strange behavior that sometimes they run and sometimes they don't. I can't really see your entire script but I can show you how I have adopted your code and made it work each time.

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

Note: your question is somehow related to ExecuteComplete ADODB Connection event not fired with adAsyncExecute parameter

注意：您的问题与ExecuteComplete ADODB Connection 事件没有用 adAsyncExecute 参数触发有关

I have added 3 stored procedures on my SQL server; sp_WaitFor5, sp_WaitFor10, sp_WaitFor20to simulate the delay of query execution time.

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

As simple as

就这么简单

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

for all 3 delays.

对于所有 3 个延迟。

Then in my Module1I added a very simple code to call the custom class

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

Option Explicit

Private clsTest As TestEvents

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

Then I have renamed the class module to TestEventsand added a slightly modified version of your code

然后我将类模块重命名为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

I have not really changed much except the extra parameterfor Executeand some code which populates activesheet just to take the time.

我真的没有太大的改变，除了额外的参数进行Execute一些代码填充activesheet只是花时间。

---

---

Now, I am able to run different variations/configurations. I can rotate the execution time for connection objects. I can have cnA5 sec, cnB10sec, cnC20sec. I can swap/adjust the execution times for each of the _ExecuteCompleteevents.

现在，我可以运行不同的变体/配置。我可以轮换连接对象的执行时间。我可以有cnA5 秒、cnB10 秒、cnC20 秒。我可以交换/调整每个_ExecuteComplete事件的执行时间。

From testing on my own I can assure you all 3 are alwaysexecuted.

通过我自己的测试，我可以向你保证所有 3 个总是被执行。

Here's some logs based on a configuration similar to yours

这是一些基于类似于您的配置的日志

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

In the above example as you can see, all 3 queries are fired asynchronously.

如您所见，在上面的示例中，所有 3 个查询都是异步触发的。

cnAreturns the handle after 5 secs which makes cnBthe first one to have the event ('refresh script') run in the hierarchy as cnCtakes the longest.

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

Since cnBcomes backfirst, it fires it's cnB_ExecuteCompleteevent procedure. The cnB_ExecuteCompleteitself it's set to take some time execute (iterates 1 million times and fills in column B with random numbers. Note: cnA populates column A, cnB col B, cnC col C). Looking at the above log it takes exactly 30 seconds to run.

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

While the cnB_ExecuteCompleteis doing its job /taking up resources (and as you know VBA is single threaded) the cnA_ExecuteCompleteevent is added up to the queue of TODO processes. So, you can think of it like a queue. While something is being taken care of the next thing has to just wait for its turn in the end.

当它在cnB_ExecuteComplete做它的工作/占用资源时（你知道 VBA 是单线程的），cnA_ExecuteComplete事件被添加到 TODO 进程的队列中。所以，你可以把它想象成一个队列。当某事正在处理时，下一件事必须等待最终轮到它。

---

---

If I change the configuration; cnA5 sec, cnB10 sec, cnC20 sec and have each of the 'refresh scripts'iterate 1 million times then

如果我改变了配置；cnA5 秒、cnB10 秒、cnC20 秒，然后让每个“刷新脚本”迭代 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 

Clearly proved my point from the first example.

从第一个例子中清楚地证明了我的观点。

Also, tried with cnA5 sec, cnB5 sec, cnC5 sec

另外，尝试了cnA5 秒、cnB5 秒、cnC5 秒

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

Which also completes/executes all 3.

这也完成/执行所有 3。

---

---

Like I've said I can't see your entire code, maybe you're having an unhandled error somewhere in your code, maybe there is something misleading you to think that one _ExecuteCompleteis not executing at all. Try to make changes to your code to reflect the one I have given you and run a few more text on our own. I will be looking forward to your feedback.

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

回答by Trace

I'm also not sure why the event does not always get fired for you.
For me, the test always worked (tested with 100 000 rows and 14 columns), but I'm not sure about the size of your database and complexity of the queries that you are executing.

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

I've got a remark though.

不过我有意见。

There is an important difference between the ExecuteCompleteand the FetchCompleteEvent.

TheExecuteComplete和FetchCompleteEvent之间有一个重要的区别。

The ExecuteCompletefires after a command has finished executing (in your example, the command object is internally created by ADO). This does not necessarily mean that all records have been fetched by the time this callback fires.

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

Hence, if you need the returned recordset to work with, you should listen to the fetchCompletecallback, that only fires when the recordset was entirely fetched.

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

回答by Nigel Heffernan

I can give you an answer that will help you some of the time, but not all the time.

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

Sometimes your Recordset.Open or your Command.Execute ignores the AdAsynchFetchparameter.

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

That is to say: the problem manifests immediately, when you are requesting, and it's not an issue with the application in an unresponsive state when ADODB calls back with a populated recordset.

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

Fortunately, this is something you can trap in the code; and there are three things that occur when AdFetchAsynch is ignored:

幸运的是，这是您可以在代码中捕获的内容；当 AdFetchAsynch 被忽略时，会发生三件事：

1. The Execute or Open method runs synchronously and populates a recordset.
2. The ExecuteCompleteevent is never raised.

1. Execute 或 Open 方法同步运行并填充记录集。
2. 该ExecuteComplete事件永远不会引发。

You can see where I'm going with this...

你可以看到我要去哪里...

If your recordset-requesting code detects an open recordset before it exits, pass the open recordset straight into your existing _FetchCompleteevent procedure:

如果您的记录集请求代码在退出之前检测到一个打开的记录集，请将打开的记录集直接传递到您现有的_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

Obviously this is going to be useless if the _FetchCompleteevent is never raised: 'open' runs asynchronously and the method exits with a recordset in state adStateConnecting or adStateFetching and you're totally reliant on the m_rst_FetchCompleteevent procedure.

显然，如果_FetchComplete从未引发事件，这将是无用的：'open' 异步运行并且该方法退出时带有状态为 adStateConnecting 或 adStateFetching 的记录集，并且您完全依赖于m_rst_FetchComplete事件过程。

But this fixes the issue some of the time.

但这有时会解决问题。

Next: you need to check that Application.EnableEventsis never set to false when you might have a recordset request out in the ether. I'm guessing that you've thought of that, but it's the only other thing that I can think of.

下一步：Application.EnableEvents当您可能在以太中发出记录集请求时，您需要检查从未设置为 false。我猜你已经想到了这一点，但这是我唯一能想到的其他事情。

Also:

还：

A tip for readers who are new to ADODB coding: consider using adCmdStoredProcand calling your saved query or your recordset-returning function by name instead of using 'SELECT * FROM' and adCmdText.

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

A late answer here, but other people will encounter the same problem.

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