Running multiple async queries with ADODB - callbacks not always firing

后端 未结 3 544
时光取名叫无心
时光取名叫无心 2020-12-05 16:07

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

相关标签:
3条回答
  • 2020-12-05 16:25

    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.

    I've got a remark though.

    There is an important difference between the ExecuteComplete and the FetchComplete Event.

    The ExecuteComplete fires 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.

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

    0 讨论(0)
  • 2020-12-05 16:49

    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

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

    As simple as

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

    for all 3 delays.

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

    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 TestEvents and added a slightly modified version of your code

    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 parameter for Execute and some code which populates activesheet just to take the time.


    Now, I am able to run different variations/configurations. I can rotate the execution time for connection objects. I can have cnA 5 sec, cnB 10sec, cnC 20sec. I can swap/adjust the execution times for each of the _ExecuteComplete events.

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

    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.

    cnA returns the handle after 5 secs which makes cnB the first one to have the event ('refresh script') run in the hierarchy as cnC takes the longest.

    Since cnB comes back first, it fires it's cnB_ExecuteComplete event procedure. The cnB_ExecuteComplete itself 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.

    While the cnB_ExecuteComplete is doing its job /taking up resources (and as you know VBA is single threaded) the cnA_ExecuteComplete event 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.


    If I change the configuration; cnA 5 sec, cnB 10 sec, cnC 20 sec and have each of the 'refresh scripts' iterate 1 million times then

    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 cnA 5 sec, cnB 5 sec, cnC 5 sec

    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.


    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 _ExecuteComplete is 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.

    0 讨论(0)
  • 2020-12-05 16:49

    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 AdAsynchFetch parameter.

    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.

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

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

    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 _FetchComplete event procedure:

    
    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 _FetchComplete event 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_FetchComplete event procedure.

    But this fixes the issue some of the time.

    Next: you need to check that Application.EnableEvents is 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.

    Also:

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

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

    0 讨论(0)
提交回复
热议问题