ConnectToConnectionPoint offers low-level alternative wiring for VBA events

I really like when I chance across some low-level technical wizardy to help out when VBA hits its limits ( it is what this blog does best!) Today, on StackOverflow a reward bounty of 500 is being awarded to a cracking answer which uses the ConnectToConnectionPoint Win32 API function call to sink events without using the WithEvents keyword.

So, I came across this StackOverflow Q & A where the questioner is asking how to reduce WithEvent declarations and subs with VBA and ActiveX and the responder provides a solution which uses ConnectToConnectionPoint to acquire events without using WithEvents.

The responder says they found the original code on a Japanese website and indeed I believe they are referring to this from Keiichi Tsunoda: Implementation of the event handling by API : ConnectToConnectionPoint. ConnectToConnectionPoint is defined in shlwapi.h which is part of the Windows Shell API (so it's not part of the original COM runtime API).

Googling a little more and I found a VBFormus post, a Mr Excel post and a GitHub Gist which I have placed in the Links section below.

How significant is this for Excel VBA? I do believe it is already possible to reduce the number of WithEvent declarations by introducing a class and holding an array of instances of those classes. Each class instance would be instantiated with the reference to a ActiveX control acquired using OLEObjects() for a worksheet or Controls() for a UserForm. However, the fact that the implementation of ConnectToConnectionPoint is in the Windows Shell library which is what Windows Desktop and the Windows Explorer use suggests that its use for sinking events from other Windows processes may have a more dramatic potential.

However, Mathieu Guindon who runs the RubberDuck project thinks this is a key technology to solving a glitch that had been an obstacle in implementing MVVM for VBA, here is his blog post Making MVVM Work in VBA Part 2 - Event Propagation

Links

• Microsoft Docs - Win32 apps - ConnectToConnectionPoint function (shlwapi.h)
• Stack Overflow - Reduce WithEvent declarations and subs with VBA and ActiveX
• Keiichi Tsunoda in Japan - http://addinbox.sakura.ne.jp/ - Implementation of the event handling by API : ConnectToConnectionPoint
• GitHub Gist - kumatti1 - Use ConnectToConnectionPoint to fire DocumentComplete
• VBForums - ConnectToConnectionPoint not working for sinking Ribbon CommandBarButton Click Event
• MrExcel Message Board - Single Class and EventHandler for multiple Control types in Userform
• Rubberduck News - Making MVVM Work in VBA Part 2 - Event Propagation
• Google - ConnectToConnectionPoint

VBA, ADODB - Asynchronous Query Execution with ADODB.Connection Events

VBA doesn't have multiple threads but that's ok because network latent operations such as running queries are packed into libraries which do the multi-threading for you. The ADODB.Connection object that is used to connect to a database can run queries in asynchronous mode with notification of completion implemented with an event if you declare the Connection object with the WithEvents keyword and and supply adAsyncExecute to the Connection's Execute method.

What follows is a code pattern not actual code because I do not know what databases you have installed on your computer dear reader. But what must be stressed is that this is to be placed into a class module (not a standard module). I called my class AsyncQuery

Option Explicit

Private WithEvents cnAsynchronousConnection As ADODB.Connection

Public Sub RunAsyncQuery()
    
    Set cnAsynchronousConnection = New ADODB.Connection

    cnAsynchronousConnection.connectionString = "" '<---- Insert your connection string

    
    cnAsynchronousConnection.Open
    
    Debug.Print "Preparing to execute asynchronously: " & Now
    cnAsynchronousConnection.Execute "<select query>", adAsyncExecute  '<----- Insert you own query

    Debug.Print "Has begun executing asynchronously: " & Now
End Sub

Private Sub cnAsynchronousConnection_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 "The query has completed asynchronously: " & Now
End Sub

Then in a standard module place the following code.

Option Explicit

Sub Test()
    Dim oAsyncQuery As AsyncQuery
    Set oAsyncQuery = New AsyncQuery

    oAsyncQuery.RunAsyncQuery

End Sub

So without a database we can't take this any further. There are two key points working here, firstly there is the WithEvents keyword in the variable declaration which is only valid in a class module. Secondly there is the flag adAsyncExecute which must be passed to the Connection's Execute method. I have highlighted these key points in bold red.

VBA - XMLHTTP60 - Tricky event handling

Summary: XMLHTTP60 does not have any standard VBA events but by adding a class and pulling a trick in a text editor we can track events.

So neither MSXML2.XMLHTTP60 nor MSXML2.ServerXMLHTTP60 have any standard VBA events that can be trapped by declaring a variable with the WithEvents keyword. This contrasts with the WinHttp.WinHttpRequest class (see prior blog post for example code). However, we can still trap events but we have to pull a trick or two along the way. The official tutorial from Microsoft is given here, Microsoft - Use the onReadyStateChange Property (Visual Basic)

One needs to create a VBA class to handle the events. I give the source next but this is exported file source to be copied into a text editor such as Notepad, saved and then imported in the VBA IDE. Do not cut and paste directly into the VBA IDE. This is because of a line of hidden source code which is given here

Attribute Item.VB_UserMemId = 0

This line will disappear from view once the class module is imported. [In case you're interested in what it does, setting UserMemId=0 makes it the default method which means you can call it whatever you want because the caller will ask for it by its Dispatch Id (0), this is an IDispatch trick]. The top 9 lines also disappear but that is standard behaviour.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "XHRSink"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' In text editor, need to put "Attribute Item.VB_UserMemId = 0" on line underneath next line, 
' save and then import into VBA IDE, this sets the default method of this class
' Then we set an instance of this class to the OnReadyStateChange property of
' MSXML2.XMLHTTP60 or MSXML2.ServerXMLHTTP60 to get events
' The line "Attribute Item.VB_UserMemId = 0" will DISAPPEAR from view once imported
Sub OnReadyStateChange()
 Attribute Item.VB_UserMemId = 0

    Debug.Print goXHR.readyState
    If goXHR.readyState = 4 Then
        Debug.Print "sink code handling result"
        Debug.Print goXHR.responseText
    End If
End Sub

So now that the above class is imported, it should read XHRSink in the project folder, we can use it when setting the OnReadyStateChange [N.B. we don't use the Set keyword, this is not a typo!] of XMLHTTP60 (or ServerXMLHTTP60) . We are calling a slow and chunky web service built in a prior blog post.

Option Explicit

'* Tools->References
'MSXML2      Microsoft XML, v6.0      C:\Windows\SysWOW64\msxml6.dll


Global goXHR As MSXML2.XMLHTTP60

'https://msdn.microsoft.com/en-us/library/ms757030(v=vs.85).aspx


Public Sub HttpGet()
    On Error GoTo ErrHandler

    Randomize
    Debug.Print String(10, vbNewLine)

    Dim bAsync As Boolean
    'bAsync = True
    bAsync = False

    Set goXHR = New MSXML2.XMLHTTP60
    
    '* need random number in query parameters to make url unique and stop caching
    goXHR.Open bstrMethod:="GET", bstrURL:="http://localhost:34957/slowAndChunkyWebService?chunkCount=5&random=" & Rnd(1), varAsync:=bAsync
    
    Dim oSink As XHRSink
    Set oSink = VBA.IIf(bAsync, New XHRSink, Nothing)
    
    goXHR.OnReadyStateChange = oSink
    
    
    goXHR.send
    
    Debug.Print "send called with bAsync=" & bAsync
    If bAsync = False Then
        Debug.Print "main code handling result with bAsync=" & bAsync
        If goXHR.readyState = 4 Then Debug.Print goXHR.responseText
    End If
    
SingleExit:
    Exit Sub
ErrHandler:
    Debug.Print "Error (" & Err.Number & ") " & Err.Description
    Stop
    Resume
    
End Sub

To experiment swap the commenting on bAsync = True and bAsync = False. The code reports to the Immediate window what it is doing. Sadly no option to chunk the response is available (not that I know of). Here is some sample reported output when bAsync = True.

send called with bAsync=True
 2 
 3 
 4 
sink code handling result
foobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobarfoobar...

Ok, so that works but how extendable is it? What happens with multiple requests? So for multiple requests one would need to upgrade the XHRSink class with an identifier to tie it back to the source; this is a bit poor but not impossible.

Final thoughts. The limited event handling for XMLHTTP60 needs to be compared and contrasted with (a) WinHttpRequest (b) that found in modern browsers facilitated by jQuery and (c) that found on the web servers such as Node.js I would be very tempted to write web service client code in Node.js and then allow VBA to call in to the finalised and processed results.