Quick program to download and parse UK Parliament Petition JSON data onto a worksheet

It's nice to pop onto my own blog and take some working code and re-apply it for a current problem. My JSON parsing posts are quite popular. In this instance I wanted to download and parse JSON data from the United Kingdom Parliamentary Petitions website.

The petition data gives two drill downs: (i) signature count by region and (ii) signature count by constituency.

The clever JSON parsing code is given to us by Douglas Crockford from his github site, you can see it being downloaded in the function SC (stands for Script Control).

Parsing returns a JSON object that is scriptable from VBA upon which we use VBA.CallByName(jsonObject, <property name>, VbGet) to drill down through the tree nodes.

If the scriptable JSON object is an array that it will support VBA's For Each .. Next syntax and so looping through is a breeze.

All the remaining code is simply plain vanilla that pastes the results on to the worksheet.

Don't forget to go to Tools->References and add the dependencies listed in the top comments or it will not compile. Also the code expects a worksheet with two sheets with codenames Sheet1 and Sheet2.

Enjoy!

Option Explicit

'* Tools->References
' MSScriptControl      Microsoft Script Control 1.0    C:\Windows\SysWOW64\msscript.ocx
' MSXML2               Microsoft XML, v6.0             C:\Windows\SysWOW64\msxml6.dll

Private Enum enuConstituencyColumns
    eCCMP = 0
    eCCName
    eCCONSCode
    eCCCountry
    eCCSigCount
    eCCFirst = eCCMP
    eCCLast = eCCSigCount
End Enum

Private Enum enuRegionColumns
    eRCName = 0
    eRCONSCode
    eRCSigCount
    eRCFirst = eRCName
    eRCLast = eRCSigCount
End Enum

Private Const clConsituencyCount As Long = 650
Private Const clRegionCount As Long = 12

Private Sub TestGetPetitionData()
    Const cl_petition_endchildfoodpoverty As Long = 554276 'no child should be going hungry  #endchildfoodpoverty
    GetPetitionData cl_petition_endchildfoodpoverty
End Sub

Private Sub GetPetitionData(ByVal lPetitionNumber As Long)
  
    Dim sPetitionJSON As String
    sPetitionJSON = RunHttpRequest("https://petition.parliament.uk/petitions/" & lPetitionNumber & ".json")
    
    Dim oSC As ScriptControl
    Set oSC = SC
    
    'Stop
    Dim objSafelyParsed As Object
    Set objSafelyParsed = SC.Run("JSON_parse", sPetitionJSON)
   
    Dim objDataAttributes As Object
    Set objDataAttributes = VBA.CallByName(VBA.CallByName(objSafelyParsed, "data", VbGet), "attributes", VbGet)
    

    
    '********** do the constituencies ***********
    Dim objConstituencySignatures As Object
    Set objConstituencySignatures = VBA.CallByName(objDataAttributes, "signatures_by_constituency", VbGet)
    
    
    Dim vConstituencies(0 To clConsituencyCount - 1, eCCFirst To eCCLast) As Variant
    
    Dim objConstituencyLoop As Object
    Dim idxConstituencyLoop As Long: idxConstituencyLoop = 0
    For Each objConstituencyLoop In objConstituencySignatures
    
        vConstituencies(idxConstituencyLoop, eCCMP) = CallByName(objConstituencyLoop, "mp", VbGet)
        vConstituencies(idxConstituencyLoop, eCCName) = CallByName(objConstituencyLoop, "name", VbGet)
        Dim sONSCode As String
        sONSCode = CallByName(objConstituencyLoop, "ons_code", VbGet)
        
        vConstituencies(idxConstituencyLoop, eCCONSCode) = sONSCode
        vConstituencies(idxConstituencyLoop, eCCCountry) = Left$(sONSCode, 1)
        
        vConstituencies(idxConstituencyLoop, eCCSigCount) = CallByName(objConstituencyLoop, "signature_count", VbGet)
        'Stop
        idxConstituencyLoop = idxConstituencyLoop + 1
    Next
    Sheet1.Cells.Clear
    WriteConstituencies Sheet1, vConstituencies
    
    
    '********** do the regions ***********
    Dim objRegionSignatures As Object
    Set objRegionSignatures = VBA.CallByName(objDataAttributes, "signatures_by_region", VbGet)
    
    Dim vRegions(0 To clRegionCount - 1, eRCFirst To eRCLast) As Variant
    Dim objRegionLoop As Object
    Dim idxRegionLoop As Long: idxRegionLoop = 0
    For Each objRegionLoop In objRegionSignatures
    
        vRegions(idxRegionLoop, eRCName) = CallByName(objRegionLoop, "name", VbGet)
        vRegions(idxRegionLoop, eRCONSCode) = CallByName(objRegionLoop, "ons_code", VbGet)
        
        vRegions(idxRegionLoop, eRCSigCount) = CallByName(objRegionLoop, "signature_count", VbGet)
    
        idxRegionLoop = idxRegionLoop + 1
    Next
    Sheet2.Cells.Clear
    WriteRegions Sheet2, vRegions
    
End Sub


Private Sub WriteConstituencies(ByVal ws As Excel.Worksheet, vConstituencies)
    Dim lVerticalCursor As Long
    lVerticalCursor = lVerticalCursor + 1
    
    ws.Cells(lVerticalCursor, eCCMP + 1) = "MP"
    ws.Cells(lVerticalCursor, eCCName + 1) = "Name"
    ws.Cells(lVerticalCursor, eCCONSCode + 1) = "ONS Code"
    ws.Cells(lVerticalCursor, eCCCountry + 1) = "Country"
    ws.Cells(lVerticalCursor, eCCSigCount + 1) = "Signature Count"
    lVerticalCursor = lVerticalCursor + 1
    
    Dim rngConstituencyPaste As Excel.Range
    Set rngConstituencyPaste = ws.Range(ws.Cells(lVerticalCursor, eCCFirst + 1), ws.Cells(lVerticalCursor + clConsituencyCount - 1, eCCLast + 1))
    
    'Debug.Assert rngConstituencyPaste.Columns.Count = 5
    'Debug.Assert rngConstituencyPaste.Rows.Count = 650
    
    rngConstituencyPaste.Value = vConstituencies
End Sub


Private Sub WriteRegions(ByVal ws As Excel.Worksheet, vRegions)
    Dim lVerticalCursor As Long
    lVerticalCursor = lVerticalCursor + 1
    
    ws.Cells(lVerticalCursor, eRCName + 1) = "Name"
    ws.Cells(lVerticalCursor, eRCONSCode + 1) = "ONS Code"
    ws.Cells(lVerticalCursor, eRCSigCount + 1) = "Signature Count"
    lVerticalCursor = lVerticalCursor + 1
    
    Dim rngRegionPaste As Excel.Range
    
    Set rngRegionPaste = ws.Range(ws.Cells(lVerticalCursor, eRCFirst + 1), ws.Cells(lVerticalCursor + clRegionCount - 1, eRCLast + 1))
    
    'Debug.Assert rngRegionPaste.Columns.Count = 3
    'Debug.Assert rngRegionPaste.Rows.Count = 12
    
    rngRegionPaste.Value = vRegions
End Sub


Private Function SC() As ScriptControl
    Static soSC As ScriptControl
    If soSC Is Nothing Then

        Set soSC = New ScriptControl
        soSC.Language = "JScript"
        
        '* https://stackoverflow.com/questions/45015/safely-turning-a-json-string-into-an-object
        soSC.AddCode RunHttpRequest("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")
        soSC.AddCode "function JSON_parse(sJson) { return JSON.parse(sJson); } "
        

    End If
    Set SC = soSC
End Function

Private Function RunHttpRequest(ByVal sURL As String) As String

    Dim xHTTPRequest As MSXML2.XMLHTTP60
    Set xHTTPRequest = New MSXML2.XMLHTTP60
    xHTTPRequest.Open "GET", sURL, False
    xHTTPRequest.send
    RunHttpRequest = xHTTPRequest.responseText

End Function

Use Python to write file tags from Excel VBA

This post was prompted by a bounty on a Stack Overflow question which details VBA code that can read file tags; questioner wants to know if VBA can write these tags as well. Sorry to say that I do not know of any current VBA referencable type libraries (there was once a DSOFiles.dll but not on my current machine). Instead we can leverage the comprehensive Python ecosystem and create a Python class callable from Excel VBA, below is a Python listing for the FilePropertiesSetter.py script.

The Python COM gateway class pattern is one I give dozens of times on this blog so I will skip details of that. The key magic is in the FilePropertiesSetter.changeSingleProperty() method which I give now without error handling ...

1 properties = propsys.SHGetPropertyStoreFromParsingName(self.filename, 
                            None, shellcon.GPS_READWRITE, propsys.IID_IPropertyStore)
2 propKey = propsys.PSGetPropertyKeyFromName(propName)
3 newValuesType = (pythoncom.VT_VECTOR | pythoncom.VT_BSTR) if isinstance(newValue,list) else pythoncom.VT_BSTR
4 propVariantNewValue = propsys.PROPVARIANTType(newValue, newValuesType)
5 properties.SetValue(propKey,propVariantNewValue)
6 properties.Commit()

So, essentially this code opens up the file's tag property store (line 1). On line 2 we find the property's key from the property's friendly name (e.g. "System.Category"). Line 3 determines if we're dealing we an array or not to help construct the new property. Line 4 constructs the new value in a form acceptable to that particular library. Line 5 actually makes the change. Line 6 commits the change and closes the file store.

The rest of the script is essentially helper methods.

The scripts has a number of libraries and so be prepared for some installation, some pip install commands. One pitfall I had to code for is when user passes in a two dimensional variant array such as if they had lifted values off a block of cells (I think the StackOverflow questioner was wanting this), the code to handle this is in FilePropertiesSetter.ensureList() which also split a comma separated string into an array (list).

FilePropertiesSetter.py needs to run once, and will request Administrator privileges to register the class with the COM registry.

FilePropertiesSetter.py

import os
import pythoncom
from win32com.propsys import propsys, pscon
from win32com.shell import shellcon
from win32com.server.exception import COMException
import winerror
import numpy

class FilePropertiesSetter(object):	
    _reg_clsid_ = "{5ED433A9-C5F9-477B-BF0A-C1643BBAE382}"
    _reg_progid_ = 'MyPythonProject3.FilePropertiesSetter'
    _public_methods_ = ['setFilename','setTitle','setKeywords','setCategory','setSubject','setComment']
	
    def __init__(self):
        pass

    def setFilename(self, filename: str):
        if not os.path.exists(filename):
            raise COMException(description="Specified file '" + filename + "' does not exist!  Subsequent calls will fail!", 
                    scode=winerror.E_FAIL, source = "FilePropertiesSetter")
        else:
            self.filename = filename

    def ensureList(self, arg):
        # despite hinting that one pass a string it seems Python will accept a VBA array as a tuple
        # so I need to convert tuples to a list, and split csv strings to a list
        # and flatten any 2d tables to a list

        try:
            if type(arg) is tuple:
                list2 = list(arg)
                
                if numpy.ndim(list2)>1:
                    # flatten any two dimension table to a one dimensional list
                    return [item for sublist in list2 for item in sublist]
                else:
                    return list2
            else:
                if isinstance(arg,list):    
                    return arg
                else:
                    return arg.split(",")

        except Exception as ex:
            raise COMException(description="error in ensureList for arg '" + str(arg)  + "'\n" + (getattr(ex, 'message', repr(ex))) ,
                    scode=winerror.E_FAIL, source = "FilePropertiesSetter")

    def setTitle(self, title: str):
    	# https://docs.microsoft.com/en-us/windows/win32/properties/props-system-title
    	self.changeSingleProperty( "System.Title", title)

    def setKeywords(self, keywords: str):

        # https://docs.microsoft.com/en-us/windows/win32/properties/props-system-keywords
        self.changeSingleProperty( "System.Keywords", self.ensureList(keywords))

    def setCategory(self, category: str):
        # https://docs.microsoft.com/en-us/windows/win32/properties/props-system-category
        self.changeSingleProperty( "System.Category", self.ensureList(category)  )

    def setSubject(self, subject: str):
        # https://docs.microsoft.com/en-us/windows/win32/properties/props-system-subject
        self.changeSingleProperty( "System.Subject", subject)

    def setComment(self, comment: str):
        # https://docs.microsoft.com/en-us/windows/win32/properties/props-system-comment
        self.changeSingleProperty( "System.Comment", comment)

    def changeSingleProperty(self,  propName: str, newValue):
        propKey = None 
        if hasattr(self,'filename') and self.filename is not None:      

                try:
                    properties = propsys.SHGetPropertyStoreFromParsingName(self.filename, 
                            None, shellcon.GPS_READWRITE, propsys.IID_IPropertyStore)
                except Exception as ex:
                    raise COMException(description="Could not open properties for file '" + self.filename + "'\n" + (getattr(ex, 'message', repr(ex))) ,
                            scode=winerror.E_FAIL, source = "FilePropertiesSetter")
            
                try:

                    propKey = propsys.PSGetPropertyKeyFromName(propName)
                except Exception as ex:
                    raise COMException(description="Could not find property key for property named '" + propName + "'\n" + (getattr(ex, 'message', repr(ex)))  , 
                            scode=winerror.E_FAIL, source = "FilePropertiesSetter")
                    
                if propKey is not None:
                    try: 
                        newValuesType = (pythoncom.VT_VECTOR | pythoncom.VT_BSTR) if isinstance(newValue,list) else pythoncom.VT_BSTR
                        propVariantNewValue = propsys.PROPVARIANTType(newValue, newValuesType)
                        properties.SetValue(propKey,propVariantNewValue)
                        properties.Commit()
                    except Exception as ex:
                        raise COMException(description="Error whilst setting value ...'\n" + (getattr(ex, 'message', repr(ex)))  , 
                                scode=winerror.E_FAIL, source = "FilePropertiesSetter")

def RegisterThis():
    print("Registering COM servers...")
    import win32com.server.register
    win32com.server.register.UseCommandLine(FilePropertiesSetter)

if __name__ == '__main__':
    RegisterThis()	
    pass

def Test():
    propsSetter=FilePropertiesSetter()
    propsSetter.setFilename(r"N:\FileProps\Newbook.xlsx") # use your own filename (obviously)
    propsSetter.setKeywords("python,keywords")
    propsSetter.setCategory("python,category")
    propsSetter.setTitle("python title")
    propsSetter.setSubject("python subject")
    propsSetter.setComment("python comment")

After FilePropertiesSetter.py is run once and correctly registered (don't forget you may need some installation) then it is scriptable from VBA with code like the following ...

Option Explicit

Sub TestPythonClass()

    Dim objPropsSetter As Object
    Set objPropsSetter = VBA.CreateObject("MyPythonProject3.FilePropertiesSetter")
    
    objPropsSetter.setFilename "N:\FileProps\Newbook.xlsx"
    objPropsSetter.setTitle "VBA Title"
    objPropsSetter.setSubject "VBA Subject"
    objPropsSetter.setComment "VBA Comment"
    objPropsSetter.setKeywords "Foo2,bar"
    'objPropsSetter.setKeywords Array("Foo1", "bar1")
    objPropsSetter.setCategory Sheet1.Range("A1:B2").Value2

End Sub

You will need to call setFilename because that is how the script knows which file to operate upon.

Enjoy!

Soft Links assist with Hard Link Hell

If you build an Excel application of any size then you will probably use more than one workbook. To access information in another workbook the standard way is to link. However, having workbooks linked to one another often leads to problems managing the opening and closing of linked workbooks. In this post I offer a 'soft link' which aims to break the hard links which come as a default and let your code take control.

There is such a thing as dependency hell where it required to gather antecedent code or data. A specific instance on Windows is DLL Hell concerning the loading of correct executable libraries. In Excel, we have our own form which I am calling 'Hard Link Hell'.

I call Hard Link Hell the mess that VBA coders can encounter when we build a VBA application of size that spans multiple workbooks. In my opinion, a VBA coder ought to exercise as much control as possible over the opening and closing of workbooks. Have a cell in one workbook link to another raises the spectre of Excel opening linked workbooks when we were not expecting it.

Admittedly, there is some control over the behaviour. So from the Data ribbon if I select Edit Links then I get the following dialog box...

... where we can see in the bottom right corner the Startup Prompt button which if pressed raises the following dialog ...

Nevertheless, I have had Hard Link Hell in the past where I have had the break links and relink to a new workbook. I remember it being a nightmare. So, in this post I give some code called Soft Links which means VBA code can take control of when to open linked workbooks. The code ships two functions to be called from a worksheet, SoftLink(workbookName, sheetName, rangeName) which actually return an Excel.Range object but Excel is clever enough to call the Value property; but this works only for single cell references. So for multiple cells use SoftLinkValue(workbookName, sheetName, rangeName). Be aware that the source cell(s) must be named using a range name. Also in the listing are some test procedures

Note, you will have to write code to open the source workbooks or you will get a #VALUE!, but we wanted to take control and so comes the responsibility to ensure the source workbook is loaded when this function is calculated. Enjoy!

Option Explicit

'* Use this for a source comprising multiple cells
Public Function SoftLinkValue(ByVal sWorkbookName As String, ByVal sSheetName As String, ByVal sRangeName As String)
    Dim rng As Excel.Range
    Set rng = SoftLink(sWorkbookName, sSheetName, sRangeName)
    SoftLinkValue = rng.Value
End Function

'* Use this for a source comprising single cell, also useful in other VBA code
Public Function SoftLink(ByVal sWorkbookName As String, ByVal sSheetName As String, ByVal sRangeName As String) As Excel.Range
    Dim wb As Excel.Workbook
    Set wb = OernColItem(Application.Workbooks, sWorkbookName)

    If Not wb Is Nothing Then

        Dim ws As Excel.Worksheet
        Set ws = OernColItem(wb.Worksheets, sSheetName)
        
        If Not ws Is Nothing Then
            Set SoftLink = OernWorksheetRange(ws, sRangeName)
        End If
    End If
End Function

Private Function OernWorksheetRange(ByRef ws As Excel.Worksheet, ByVal sRangeName As String) As Excel.Range
    On Error Resume Next
    Set OernWorksheetRange = ws.Range(sRangeName)
End Function

Private Function OernColItem(ByRef col As Object, ByVal idx As Variant) As Object
    On Error Resume Next
    Set OernColItem = col.Item(idx)
End Function

'**** TEST ****

Sub TestVBACallingSoftLink_LocalSheet()

    Const csSHEET1 As String = "Sheet1"

    Dim rng As Excel.Range
    Set rng = SoftLink(ThisWorkbook.Name, csSHEET1, "A1")
    
    Debug.Assert Not rng Is Nothing
    If Not rng Is Nothing Then
        Debug.Assert rng.Address = "$A$1"
        Debug.Assert rng.Worksheet.Name = csSHEET1
    End If
End Sub


Sub TestVBACallingSoftLink_ExternalWorkbook()
    Const csSHEET1 As String = "Sheet1"

    '*** test setup: create new workbook, add a name
    Dim wbNew As Excel.Workbook
    Set wbNew = Application.Workbooks.Add
    
    Const csNAME_FOO As String = "Foo"
    Dim ws As Excel.Worksheet
    Set ws = wbNew.Worksheets.Item(1)
    ws.Names.Add Name:=csNAME_FOO, RefersToR1C1:="=Sheet1!R4C8"
    ws.Range(csNAME_FOO).Value2 = 42
    '*** end of test setup:

    '*** now we can call our function to get a link to an external workbook
    Dim rng As Excel.Range
    Set rng = SoftLink(wbNew.Name, csSHEET1, csNAME_FOO)
    
    Debug.Assert Not rng Is Nothing
    If Not rng Is Nothing Then
        Debug.Assert rng.Address = "$H$4"
        Debug.Assert rng.Worksheet.Name = csSHEET1
        Stop
    End If
    wbNew.Close False
    Stop
End Sub

VBA - Writing code in the Immediate window

You can write mini-programs in the Immediate window but you'll need to change how you write code. If you want a VBA code challenge this morning this will challenge you.

So a Stack Overflow answer to this question is due to be awarded a bounty. The prize winning answer doesn't actually solve the question which is how to print a two dimensional array to the Immediate window; instead, the answer highlights the Locals window (it's a favorite of mine as well). Nevertheless this question and its answers caught my attention and amongst them was a mini-program meant to be run entirely from the Immediate window, the code and output is show below.

arr = [ {"A",1; "B",2; "C",3 } ]: _
For r = LBound(arr, 1) To UBound(arr, 1): _
        For c = LBound(arr, 2) To UBound(arr, 2): _
            Debug.Print arr(r, c): _
       Next c: _
Next
A
 1 
B
 2 
C
 3 

I have seen code for the Immediate window before and wondered 'Why bother?' when you can write a small function and so didn't register the pattern and syntax required but today for whatever reason I embraced this syntax.

I wasn't happy with the output of the given code and wanted to amend it and then I hit the syntactical challenges therein. A small list of bullet points is appropriate here.

• You can't use Dim statements; so write code as if Option Explicit is commented out
• You can't use a For statement with a Next statement so you are obliged to use multi-line statements
• If statements cannot be multi-line version they must be single line version. I.e. Don't use End If
• Feel free to use VBA.IIf instead of an If statement.

So I successfully amended the code to give output with which I'm happy.

    arr = [ {"A",1; "B",2; "C",3 } ]: _
    sAcc = "": _
    For r = LBound(arr, 1) To UBound(arr, 1): _
            For c = LBound(arr, 2) To UBound(arr, 2): _
                bRowEnd = (c = UBound(arr, 2)): _
                sAcc = sAcc & CStr(arr(r, c)) & VBA.IIf(bRowEnd, ";" & vbNewLine, ","): _
           Next c: _
    Next r: _
    Debug.Print sAcc
A,1;
B,2;
C,3;

Be mindful that your variables in the 'ether' of the Immediate window will hang around until either (a) you suffer a state loss or (b) you type End which deliberately causes a variables wipedown. This is why I clear down sAcc at the start of the mini-program, otherwise repeated execution makes it build up.

You can instantiate classes in the Immediate window but the Intellisense didn't work (Intellisense did work for standard modules).

This is all a long way from Python's REPL I must say. If you any comments, suggestions or tips for working with the Immediate window do please drop me a line below.

Python COM Component to get windows handles hierarchy

In this blog I give a Python COM component that returns a windows handle hierarchy as found in Spy++. It returns the details in one large table.

So I had cause to poke around the windows hierarchy for Excel and I had previously written code to query the Windows API and get all the windows handles in a tree just like Spy++ but I chose to revisit the code with Python. Also, I chose to return the results in tabular form.

Here is the Python listing

import pythoncom 
import os
import logging
import win32gui
import win32con 

class LocalsEnhancedErrorMessager(object):
    @staticmethod
    def Enhance(ex, localsString):
        locals2 = "n Locals:{ " + (",n".join(localsString[1:-1].split(","))) + " }"
        if hasattr(ex,"message"):
            return "Error:" + ex.message + locals2
        else:
            return "Error:" + str(ex) + locals2


class PythonFindWindow(object):
    _reg_clsid_ = "{490784B6-5174-4794-8888-769DE4688B2C}"
    _reg_progid_ = 'PythonInVBA.PythonFindWindow'
    _public_methods_ = ['FindAllXlMainWindows','FindXlMainWindowWithCaptionFragment','FindChildWindows']
    _reg_clsctx_ = pythoncom.CLSCTX_LOCAL_SERVER ## uncomment this for a separate COM Exe server instead of in-process DLL

    def FindAllXlMainWindows(self):
        try:
            logging.basicConfig(filename =  (os.path.dirname(os.path.realpath(__file__))) + '\app2.log', 
                        format="%(asctime)s: %(message)s", 
                        level=logging.INFO, datefmt="%H:%M:%S")

            windows = []

            hwnd = win32gui.FindWindowEx(0,0,"XLMAIN",None)
            while hwnd != 0:
                windows.append(hwnd)
                hwnd = win32gui.FindWindowEx(0,hwnd,"XLMAIN",None)

            logging.info('PythonFindWindow.FindAllXlMainWindows completed')
            return windows
        except Exception as ex:
            msg = "PythonFindWindow.FindAllXlMainWindows error:" + LocalsEnhancedErrorMessager.Enhance(ex,str(locals()))
            logging.info(msg)
            return msg

    def FindXlMainWindowWithCaptionFragment(self, captionStringFragment):
        try:
            logging.basicConfig(filename =  (os.path.dirname(os.path.realpath(__file__))) + '\app2.log', 
                        format="%(asctime)s: %(message)s", 
                        level=logging.INFO, datefmt="%H:%M:%S")

            windows = []

            hwnd = win32gui.FindWindowEx(0,0,"XLMAIN",None)
            while hwnd != 0:
                caption = win32gui.GetWindowText(hwnd)
                if captionStringFragment in caption:
                    windows.append(hwnd)
                hwnd = win32gui.FindWindowEx(0,hwnd,"XLMAIN",None)

            logging.info('PythonFindWindow.FindXlMainWindowWithCaptionFragment completed')
            return windows
        except Exception as ex:
            msg = "PythonFindWindow.FindXlMainWindowWithCaptionFragment error:" + LocalsEnhancedErrorMessager.Enhance(ex,str(locals()))
            logging.info(msg)
            return msg


    def FindChildWindows(self, parentHandle, selectStyles):
        try:
            logging.basicConfig(filename =  (os.path.dirname(os.path.realpath(__file__))) + '\app2.log', 
                        format="%(asctime)s: %(message)s", 
                        level=logging.INFO, datefmt="%H:%M:%S")

            windows = []
            hwnd = parentHandle
            row = [hwnd,0,"{0:#0{1}x}".format(hwnd,8), 
                                win32gui.GetWindowText(hwnd), 
                                win32gui.GetClassName(hwnd),
                                win32gui.GetWindowLong(hwnd, win32con.GWL_STYLE)]
            windows.append(row)

            self.FindChildWindowsInner(parentHandle,windows, selectStyles,0)
            
            logging.info('PythonFindWindow.FindChildWindows completed')
            return windows
        except Exception as ex:
            msg = "PythonFindWindow.FindChildWindows error:" + LocalsEnhancedErrorMessager.Enhance(ex,str(locals()))
            logging.info(msg)
            return msg

    def FindChildWindowsInner(self, parentHandle, windows, selectStyles, depth):
        try:

            hwnd = win32gui.FindWindowEx(parentHandle,0,None,None)
            while hwnd != 0:
                style = win32gui.GetWindowLong(hwnd, win32con.GWL_STYLE)
                stylesSelected = True if selectStyles is None else (style & selectStyles)!=0
                if stylesSelected:
                    row = [hwnd,parentHandle,"{0:#0{1}x}".format(hwnd,8), 
                                     win32gui.GetWindowText(hwnd), 
                                     win32gui.GetClassName(hwnd),
                                     style]
                    windows.append(row)
                    self.FindChildWindowsInner(hwnd, windows, selectStyles, depth+1)
                hwnd = win32gui.FindWindowEx(parentHandle,hwnd,None,None)
            
            
            return windows
        except Exception as ex:
            msg = "PythonFindWindow.FindChildWindowsInner error:" + LocalsEnhancedErrorMessager.Enhance(ex,str(locals()))
            logging.info(msg)
            return msg



def run():
    # this code is to be run in Microsoft Visual Studio by pressing F5
    # it is a developer's entry.  for production instantiate the COM component
    try:

        print("Executing run")
        print((os.path.dirname(os.path.realpath(__file__))))

        logging.basicConfig(filename = (os.path.dirname(os.path.realpath(__file__))) + '\app2.log', 
                        format="%(asctime)s: %(message)s", 
                        level=logging.INFO, datefmt="%H:%M:%S")

        fw = PythonFindWindow()

        xlMains = fw.FindAllXlMainWindows()
        
        windowList = fw.FindChildWindows(xlMains[0], win32con.WS_VISIBLE)

        logging.info('called PythonFindWindow.FindChildWindows ...n')

        logging.info('finishing run()n')
    except Exception as ex:
        print(ex)

def RegisterCOMServers():
    print("Registering COM servers...")
    import win32com.server.register
    win32com.server.register.UseCommandLine(PythonFindWindow)

if __name__ == '__main__':
    
    RegisterCOMServers()
    run()

and here is some sample VBA client code...

Option Explicit

Const WS_VISIBLE As Long = &H10000000   'WS_VISIBLE = 0x10000000

Sub Test()
    Dim obj As Object
    Set obj = VBA.CreateObject("PythonInVBA.PythonFindWindow")
    
    Dim vXlMains
    vXlMains = obj.FindXlMainWindowWithCaptionFragment("MyWorkbook")
    
    Dim vWindows

    vWindows = obj.FindChildWindows(vXlMains(0), Empty)  '* No styles to select with, so selects all
    vWindows = obj.FindChildWindows(vXlMains(0), WS_VISIBLE)  '* Only shows those that are visible (and whose ancestors are visible)
    
    Dim lRow As Long
    For lRow = LBound(vWindows, 1) To UBound(vWindows, 1)
        If vWindows(lRow, 4) = "EXCEL7" Then
            Stop
        End If
    Next
    Stop
End Sub

Once the table is returned one can dig in and find what you want, much better to take a whole snapshot recursing down through the hierarchy then to piece together separate calls to FindWindow in my humble opinion.

VBA, Python - Python Web Server housed as a COM component

In this post I give code for a Python web server housed as a COM component which is startable and stoppable from VBA or any other COM-enabled client. The code demonstrates COM server code, Python web server code, multi-threading and Python logging.

Multithreading possible but ill-advised in VBA

Multithreading in VBA is technically possible as VBA code can access Windows API functions such as CreateThread as well as the operating system artefacts used to manage concurrency and synchronization such as semaphores, critical sections and mutexs. Unfortunately, if you create threads in VBAs and then place breakpoints in the code to debug then Excel will crash because the Excel VBA IDE is not multi-threading aware/capable. Never mind, for multi-threading problems an Excel VBA developer can co-opt either C# (or other .NET languages) or Python to build a COM component callable from VBA. In this post I use Python.

Code commentary - the COM server code

The code below demonstrates COM server code which keen readers of this blog will have seen many times before so I will be brief. The StarterAndStopper class (excerpt given below) is the COM server gateway class, we can tell this from the _reg_clsid and _reg_progid attributes as well as the list of methods. Also there is a key line of code which determines how to implement the COM server's housing; _reg_clsctx_ which if omitted defaults to an in-process DLL pattern but if pythoncom.CLSCTX_ instead then the COM server will be housed in a separate .Exe. This is extremely useful during development for tearing down one instance and replace with another implementing the latest changes.

class StarterAndStopper(object):
    ...
    _reg_clsid_ = "{2D23D974-73B1-4106-9096-DA6006BD84AA}"
    _reg_progid_ = 'PythonInVBA.StarterAndStopper'
    _public_methods_ = ['StartWebServer','StopWebServer','CheckThreadStatus','StopLogging']
    ##_reg_clsctx_ = pythoncom.CLSCTX_ ## uncomment this for a separate COM Exe server instead of in-process DLL server

the registration code is given in the following lines, these need to be run once; if not with Admin rights then an escalation is requested.

def RegisterCOMServers():
    print("Registering COM servers...")
    import win32com.server.register
    win32com.server.register.UseCommandLine(StarterAndStopper)

if __name__ == '__main__':
    #run()
    RegisterCOMServers()

then once registered the COM server is creatable with the following CreateObject line of code...

    Set mobjPythonWebServer = VBA.CreateObject("PythonInVBA.StarterAndStopper")

I will give further commentary of this class later when talking about multi-threading.

Code commentary - stoppable web server code

So we utilize the Python library's basic web server, this is not for use unless behind a firewall but is usable for facilitating HTTP communication between programs on the same computer. For robust internet-facing industrial strength production web serving one should use Apache web server with a Python plug-in. For my purposes the basic web server is fine, I am planning some code where the browser on a machine calls into Excel.exe running on the same machine, i.e. we are not internet-facing.

The base class http.server.HTTPServer has a serve_forever method which runs in an infinite loop which only interrupts when Ctrl+C is pressed on the keyboard in the console window in which the web server is running. If running in a COM server housing then there is no visible console and so we need a mechanism to stop the web server without a keyboard interrupt. The code in an article over on activestate.com gives the pattern for a stoppable web server by amending the standard implementation thus,

1. Adding an additional HTTP verb handler to the class derived from SimpleHTTPRequestHandler to handle a QUIT request. The code here sets a Stop flag to True.
2. Subclassing http.server.HTTPServer and providing overriding implementation of serve_forever that will acknowledge the stop and drop out of the (otherwise infinite) loop.
3. In the shutdown code make a HTTP QUIT request to one's own webserver

class MyRequestHandler(SimpleHTTPRequestHandler):
    ...
    def do_QUIT (self):
            # http://code.activestate.com/recipes/336012-stoppable-http-server/ 
            """send 200 OK response, and set server.stop to True"""
            self.send_response(200)
            self.end_headers()
            self.server.stop = True
            self.wfile.write("quit called".encode('utf-8'))

class StoppableHttpServer(HTTPServer):
    # http://code.activestate.com/recipes/336012-stoppable-http-server/ 
    """http server that reacts to self.stop flag"""

    def serve_forever (self):
            """Handle one request at a time until stopped."""
            self.stop = False
            while not self.stop:
                self.handle_request()

class StarterAndStopper(object):
    def StopWebServer(self):

                    ## make a quit request to our own server 
                    quitRequest  = urllib.request.Request("http://" + self.server_name + ":" + str(self.server_port) + "/quit",
                                                      method="QUIT")
                    with urllib.request.urlopen(quitRequest ) as resp:
                        logging.info("StarterAndStopper.StopWebServer      : quit response '" + resp.read().decode("utf-8") + "'")

Whilst on the subject of no visible console window, we have to redirect stdout and stderr to somewhere, e.g. a file otherwise the code complains and throws errors. So I found adding the following is sufficient to suppress such errors.

        sys.stderr = open((os.path.dirname(os.path.realpath(__file__))) + '\\logfile.txt', 'w', buffer)
        sys.stdout = open((os.path.dirname(os.path.realpath(__file__))) + '\\logfile.txt', 'w', buffer)

Code commentary - multithreading

Creating and starting a new thread in Python is quite simple using the Thread constructor threading.Thread(name, target, args) where target is a function or a class's method, in this case a standalone function called thread_function which itself simply calls the web server's serve_forever method given above. Once constructed, we call the Thread's start method.

class StarterAndStopper(object):
    def StartWebServer(self,foo, bar: str, baz: str, server_name:str, server_port: int):
            self.running = False 
            
            self.httpd = StoppableHttpServer((server_name, server_port), MyRequestHandler)

            self.serverthread = threading.Thread(name="webserver", target=thread_function, args=(self,))
            self.serverthread.setDaemon(True)
            
            self.serverthread.start()
            ... 

def thread_function(webserver):
    try:
        webserver.httpd.serve_forever()  #code enters into the subclass's implementation, an almost infinite loop
        ...

When we come to stop the web server by sending the QUIT HTTP request notifying the web server thread of close down we then call the Thread.join method on the main thread to wait for the web server thread to drop off. In the code given we set the Thread to a daemon, which means the Thread's refusal to finish does not prevent unloading the code once the main thread has finished.

Code commentary - developing a multithreaded COM component

The code is meant to be executed as a COM component with execution beginning with a COM client such as VBA. Unfortunately such a scenario does not facilitate hitting break points and stepping through the source code. For this reason a separate run() function is found at the bottom of the code. This is to be run in Microsoft Visual Studio and doing this we get to hit break points and step through the code. Sometimes, it's necessary to comment out the setDaemon(True) line so that the code does not unload, allowing continued debugging. This can be a bit of pain but until I can get the breakpoints to hit in the original scenario I will have to persist with this.

Code commentary - Python logging

In addition to the lack of breakpoints in the primary one use case (see above) the code can be difficult to debug because of the nature of multithreading. One cannot always tell the order in what events occurred! To solve this I put in the code a ton of logging so that I could see just what precisely is happening. Here is a sample of my log which expresses the sequence of events for starting the web server, using a browser to make a HTTP GET, then stopping the web server. In fact this log says so much more than any prose that I could write.

22:37:17: StarterAndStopper.StartWebServer     : server_name: localhost, server_port:8014
22:37:17: StarterAndStopper.StartWebServer     : about to create thread
22:37:17: StarterAndStopper.StartWebServer     : about to start thread
22:37:17: StarterAndStopper.StartWebServer     : after call to start thread
22:37:17: thread_function                      : about to enter webserver.httpd.serve_forever
22:37:17: StoppableHttpServer.serve_forever    : entered
22:37:20: MyRequestHandler.do_GET              : entered.  path=/testurl
22:37:20: StoppableHttpServer.serve_forever    : request successfully handled self.stop=False
22:37:22: StarterAndStopper.StopWebServer      : entered
22:37:22: StarterAndStopper.StopWebServer      : call quit on own web server
22:37:24: MyRequestHandler.do_QUIT             : entered
22:37:24: MyRequestHandler.do_QUIT             : setting self.server.stop = True
22:37:24: StoppableHttpServer.serve_forever    : request successfully handled self.stop=True
22:37:24: StarterAndStopper.StopWebServer      : quit response 'quit called'
22:37:24: StoppableHttpServer.serve_forever    : dropped out of the loop
22:37:24: StarterAndStopper.StopWebServer      : about to join thread
22:37:24: thread_function                      : returned from webserver.httpd.serve_forever
22:37:24: thread_function                      : finished
22:37:24: StarterAndStopper.StopWebServer      : thread joined
22:37:24: StarterAndStopper.StopWebServer      : about to call httpd.server_close()
22:37:24: StarterAndStopper.StopWebServer      : completed

Full Code Listings

So here is the full Python code listing which has all the full logging statements in it.

import sys
import time #sleep
import http.server
import threading
import tempfile
import os

import win32com.client
from io import BytesIO
import pythoncom

import urllib.request

from http.server import HTTPServer, BaseHTTPRequestHandler, SimpleHTTPRequestHandler
import logging

class MyRequestHandler(SimpleHTTPRequestHandler):

    def do_GET(self):
        try:
            logging.info("MyRequestHandler.do_GET              : entered.  path=" + self.path)
            self.send_response(200)
            self.send_header('Content-type', 'text/html')
            self.end_headers()
            if (self.path != r"/favicon.ico"):
                self.wfile.write("GET request for {}".format(self.path).encode('utf-8'))
                self.wfile.write((" default response").encode('utf-8'))
        except Exception as ex:
            logging.info("MyRequestHandler.do_GET   error   : " + 
                LocalsEnhancedErrorMessager.Enhance(ex,str(locals())))

    def do_POST(self):
        try:
            logging.info("MyRequestHandler.do_POST             : entered ")
            content_length = int(self.headers['Content-Length']) # <--- Gets the size of data
            post_data = self.rfile.read(content_length) # <--- Gets the data itself

            self.send_response(200)
            self.send_header('Content-type', 'text/html')
            self.end_headers()

            msgBytesReceived = "POST body:" + str(len(post_data)) + " bytes received" 

            response = BytesIO()
            response.write(msgBytesReceived.encode('utf-8'))

            self.wfile.write(response.getvalue())
            self.wfile.flush()

            print(msgBytesReceived)

            logging.info("MyRequestHandler.do_POST             : " + msgBytesReceived)

        except Exception as ex:
            logging.info("MyRequestHandler.do_POST  error    : " + 
                LocalsEnhancedErrorMessager.Enhance(ex,str(locals())))

    def do_QUIT (self):
        try:
            logging.info("MyRequestHandler.do_QUIT             : entered")
            """send 200 OK response, and set server.stop to True"""
            self.send_response(200)
            self.end_headers()
            logging.info("MyRequestHandler.do_QUIT             : setting self.server.stop = True")
            self.server.stop = True
            self.wfile.write("quit called".encode('utf-8'))
        except Exception as ex:
            logging.info("MyRequestHandler.do_QUIT  error    : " + 
                LocalsEnhancedErrorMessager.Enhance(ex,str(locals())))

class LocalsEnhancedErrorMessager(object):
    @staticmethod
    def Enhance(ex, localsString):
        locals2 = "n Locals:{ " + (",n".join(localsString[1:-1].split(","))) + " }"
        if hasattr(ex,"message"):
            return "Error:" + ex.message + locals2
        else:
            return "Error:" + str(ex) + locals2

def thread_function(webserver):
    try:
        pythoncom.CoInitialize() # need this to tell the COM runtime that a new thread exists
        webserver.running = True 

        ## we need to pipe output to a file because whilst running as COM server there is no longer a console window to print to
        buffer = 1
        sys.stderr = open((os.path.dirname(os.path.realpath(__file__))) + '\logfile.txt', 'w', buffer)
        sys.stdout = open((os.path.dirname(os.path.realpath(__file__))) + '\logfile.txt', 'w', buffer)

        logging.info("thread_function                      : about to enter webserver.httpd.serve_forever")
        webserver.httpd.serve_forever()  #code enters into the subclass's implementation, an almost infinite loop
        logging.info("thread_function                      : returned from webserver.httpd.serve_forever")
        
        logging.info("thread_function                      : finished")

    except Exception as ex:
        logging.info("thread_function   error   : " + 
            LocalsEnhancedErrorMessager.Enhance(ex,str(locals())))

class StoppableHttpServer(HTTPServer):
    # http://code.activestate.com/recipes/336012-stoppable-http-server/ 
    """http server that reacts to self.stop flag"""

    def serve_forever (self):
        try:
            logging.info("StoppableHttpServer.serve_forever    : entered")
            """Handle one request at a time until stopped."""
            self.stop = False
            while not self.stop:
                self.handle_request()
                logging.info("StoppableHttpServer.serve_forever    : request successfully handled self.stop=" + str(self.stop))
            logging.info("StoppableHttpServer.serve_forever    : dropped out of the loop")
        except Exception as ex:
            logging.info("StoppableHttpServer.serve_forever  error   : " + 
                LocalsEnhancedErrorMessager.Enhance(ex,str(locals())))
            
class StarterAndStopper(object):
    import logging
    import threading
    import time
    
    _reg_clsid_ = "{2D23D974-73B1-4106-9096-DA6006BD84AA}"
    _reg_progid_ = 'PythonInVBA.StarterAndStopper'
    _public_methods_ = ['StartWebServer','StopWebServer','CheckThreadStatus','StopLogging']
    ##_reg_clsctx_ = pythoncom.CLSCTX_ ## uncomment this for a separate COM Exe server instead of in-process DLL server

    def StopLogging(self):
        try:
            logging.shutdown()
            return "logging.shutdown() ran"
        except Exception as ex:
            msg = "StarterAndStopper.StopLogging error:" + LocalsEnhancedErrorMessager.Enhance(ex,str(locals()))
            logging.info(msg)
            return msg

    def StartWebServer(self,foo, bar: str, baz: str, server_name:str, server_port: int):
        try:
            self.server_name = server_name
            self.server_port = server_port

            logging.basicConfig(filename =  (os.path.dirname(os.path.realpath(__file__))) + '\app2.log', format="%(asctime)s: %(message)s", 
                        level=logging.INFO, datefmt="%H:%M:%S")

            logging.info("StarterAndStopper.StartWebServer     : server_name: " + server_name + ", server_port:" + str(server_port))

            self.running = False 
            
            self.httpd = StoppableHttpServer((server_name, server_port), MyRequestHandler)

            logging.info("StarterAndStopper.StartWebServer     : about to create thread")

            self.serverthread = threading.Thread(name="webserver", target=thread_function, args=(self,))
            self.serverthread.setDaemon(True)
            logging.info("StarterAndStopper.StartWebServer     : about to start thread")

            self.serverthread.start()
            logging.info("StarterAndStopper.StartWebServer     : after call to start thread")
            
            return "StartWebServer ran ok ( server_name: " + server_name + ", server_port:" + str(server_port) + ")"

        except Exception as ex:
            msg = "StarterAndStopper.StartWebServer error:" +  LocalsEnhancedErrorMessager.Enhance(ex,str(locals()))
            logging.info(msg)
            return msg

    def CheckThreadStatus(self):
        try:
            # Clear the stream now that we have finished
            global callbackInfo

            if self.running:
                if hasattr(self,'httpd') :
                    logging.info("StarterAndStopper.CheckThreadStatus    : checking thread status")
                    return self.serverthread.is_alive()
                else:
                    return "StopWebServer ran ok, nothing to stop"
            else:
                return "StopWebServer ran ok, nothing to stop"

        except Exception as ex:
            msg = "StarterAndStopper.CheckThreadStatus error:" +  LocalsEnhancedErrorMessager.Enhance(ex,str(locals()))
            logging.info(msg)
            return msg

    def StopWebServer(self):
        try:
            retMsg = "StopWebServer ran (default)"
            logging.info("StarterAndStopper.StopWebServer      : entered")

            if self.running:
                if hasattr(self,'httpd') :

                    logging.info("StarterAndStopper.StopWebServer      : call quit on own web server")
                    ## make a quit request to our own server 
                    quitRequest  = urllib.request.Request("http://" + self.server_name + ":" + str(self.server_port) + "/quit",
                                                      method="QUIT")
                    with urllib.request.urlopen(quitRequest ) as resp:
                        logging.info("StarterAndStopper.StopWebServer      : quit response '" + resp.read().decode("utf-8") + "'")

                    # web server should have exited loop and its thread should be ready to terminate
                    logging.info("StarterAndStopper.StopWebServer      : about to join thread")
                    self.serverthread.join()    # get the server thread to die and join this thread
                    self.running = False 
                    
                    logging.info("StarterAndStopper.StopWebServer      : thread joined")

                    logging.info("StarterAndStopper.StopWebServer      : about to call httpd.server_close()")
                    self.httpd.server_close()  #now we can close the server cleanly
                    
                    logging.info("StarterAndStopper.StopWebServer      : completed")

                    retMsg = "StopWebServer ran ok, web server stopped"
                else:
                    retMsg = "StopWebServer ran ok, nothing to stop"
            else:
                retMsg = "StopWebServer ran ok, nothing to stop"
            return retMsg

        except Exception as ex:
            msg = "StarterAndStopper.StopWebServer error:" +  LocalsEnhancedErrorMessager.Enhance(ex,str(locals()))
            print(msg)
            logging.info(msg)
            return msg

def run():
    # this code is to be run in Microsoft Visual Studio by pressing F5
    # use this code to step through and debug the web server portion of code 
    try:

        print("Executing run")
        print((os.path.dirname(os.path.realpath(__file__))))

        logging.basicConfig(filename = (os.path.dirname(os.path.realpath(__file__))) + '\app2.log', format="%(asctime)s: %(message)s", 
                        level=logging.INFO, datefmt="%H:%M:%S")

        ws = StarterAndStopper()
        ws.StartWebServer(None,None, None,'localhost',8009)

        logging.info('called StarterAndStopper.StartWebServer ...n')

        if False:

            logging.info('what next? ...n')
            ws.StopWebServer()

            logging.info('finishing run()n')
    except Exception as ex:
        print(ex)

def RegisterCOMServers():
    print("Registering COM servers...")
    import win32com.server.register
    win32com.server.register.UseCommandLine(StarterAndStopper)

if __name__ == '__main__':
    run()
    #RegisterCOMServers()

And here is the client VBA code which calls into the COM server (ensure it is registered!).

Option Explicit
Option Private Module

Dim mobjPythonWebServer As Object

Public Const PORT As Long = 8014

Function TestPythonVBAWebserver_StartWebServer()
    Set mobjPythonWebServer = VBA.CreateObject("PythonInVBA.StarterAndStopper")

    Debug.Print mobjPythonWebServer.StartWebServer(Null, Null, Null, "localhost", PORT)

End Function

Sub TestPythonVBAWebserver_StopWebServer()
    If Not mobjPythonWebServer Is Nothing Then
        Debug.Print mobjPythonWebServer.StopWebServer
    End If
End Sub

Sub TestPythonVBAWebserver_StopLogging()
    '# This releases the log file so I can delete it occassionally
    If Not mobjPythonWebServer Is Nothing Then
        Debug.Print mobjPythonWebServer.StopLogging
    End If
End Sub

Sub PickupNewPythonScript()
    '# for development only to help pick up script changes we kill the python process
    Call CreateObject("WScript.Shell").Run("taskkill /f /im pythonw.exe", 0, True)
    Set mobjPythonWebServer = Nothing
End Sub

VBA, Named Pipes (& JavaScript) - binary serialization revisited

In this post I revisit the matter of the serialization of VBA Variant arrays to bytes and back again. This can be used VBA to VBA or interoperating with other technologies that can be sequence bytes, in this post I demonstrate JavaScript to VBA. I incorporate a better serialization technique code that uses Windows OS Named Pipes as written by VBForums.com contributor Olaf Schmidt.

Background

This is a revisit of an earlier article where I saved and loaded a Variant array to disk using VBA’s Open File For Binary, Put and Get statements. Whilst the code did what I wanted, I had complained that my code required a disk operation which carries a performance penalty.

I am indebted to a commenter (who gives no name) who tipped me off as to some code on VBForums written by Olaf Schmidt; Olaf’s code serializes using Windows OS Named Pipes and not a disk write. The Named Pipes are purely in memory and so this makes his code faster.

Moreover, the Named Pipes serialization yields a leading sequence of bytes that describes the number of dimensions in the array and the size and bounds of each dimension. This was something formally missing from disk write version my code and which I had had to implement manually, something of a nuisance.

I am thus doubly indebted to Olaf Schmidt’s code and to the commenter who tipped me off. Thank you. Do please keep the comments coming.

VBA Class Module - cPipedVariants

So with Olaf Schmidt's code as a starting point I have modified it to handle the use case of VBA variant arrays, i.e. a two dimensional array which is ready for pasting onto a worksheet. Olaf's original code demonstrated the serialization of user-defined types and these data structures are more prevalent in Visual Basic 6 (VB6) whereas Excel developers (I would argue) are more likely to deal with grids drawn from a worksheet or grids to be pasted onto a worksheet.

If you want the original version that deals with the serialization of UDTs it is on this link here to vb6forums.com.

So what follows in cPipedVariants, a modification on Olaf's original class cPipedUDTs. Much of the code is easy to follow but I will comment on the ‘secret sauce’ of the InitializePipe function.

The two key lines of code are the call to CreateNamedPipeW and then the Open "\\.\pipe\foo" For Binary statement. If I switch the order of these two around then the code fails. Internally, in its implementation the Open For Binary Statement must have a special case where it identifies the "\\.\pipe\ " prefix and then looks up in the list of created named pipes. This is not documented in any Microsoft documentation, or indeed StackOverflow. Only the VB6Forums.com users and specifically Olaf Schmidt understand this lore, it must be a throw back to the era of VB6. Anyway, it does work and I am grateful.

Add a class to your VBA project, call it cPipedVariants and then paste in the following code

Option Explicit

'* Pipe-based helper to serialize/deserialize VB-Variants InMemory ... [based on original code by Olaf Schmidt 2015]
'* Based on code by Olaf Schmidt 2015, http://www.vbforums.com/showthread.php?807205-VB6-pipe-based-UDT-serializing-deserializing-InMemory


'* https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-createnamedpipea
Private Declare Function CreateNamedPipeW& Lib "kernel32" (ByVal lpName As Long, ByVal dwOpenMode&, ByVal dwPipeMode&, _
            ByVal nMaxInstances&, ByVal nOutBufferSize&, ByVal nInBufferSize&, _
            ByVal nDefaultTimeOut&, ByVal lpSecurityAttributes&)

'* https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-writefile
Private Declare Function WriteFile& Lib "kernel32" (ByVal hFile&, lpBuffer As Any, _
            ByVal nNumberOfBytesToWrite&, lpNumberOfBytesWritten&, ByVal lpOverlapped&)

'* https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-readfile
Private Declare Function ReadFile& Lib "kernel32" (ByVal hFile&, lpBuffer As Any, _
            ByVal nNumberOfBytesToRead&, lpNumberOfBytesRead&, ByVal lpOverlapped&)

'* https://docs.microsoft.com/en-us/windows/win32/api/namedpipeapi/nf-namedpipeapi-peeknamedpipe
Private Declare Function PeekNamedPipe& Lib "kernel32" (ByVal hNamedPipe&, lpBuffer As Any, _
            ByVal nBufferSize&, lpBytesRead&, lpTotalBytesAvail&, lpBytesLeftThisMessage&)

'* https://docs.microsoft.com/en-us/windows/win32/api/namedpipeapi/nf-namedpipeapi-disconnectnamedpipe
Private Declare Function DisconnectNamedPipe& Lib "kernel32" (ByVal hPipe&)

Private Declare Function CloseHandle& Lib "kernel32" (ByVal hObject&)

Private mhPipe As Long
Private mlFileNumber As Long
Private mabytSerialized() As Byte

Private Enum eOpenMode
    PIPE_ACCESS_INBOUND = 1
    PIPE_ACCESS_OUTBOUND = 2
    PIPE_ACCESS_DUPLEX = 3
End Enum

Private Enum ePipeMode
    PIPE_TYPE_BYTE = 0
    PIPE_TYPE_MESSAGE = 4

    PIPE_READMODE_BYTE = 0
    PIPE_READMODE_MESSAGE = 2
   
    PIPE_WAIT = 0
    PIPE_NOWAIT = 1
End Enum

Private Enum ePipeInstances
    PIPE_UNLIMITED_INSTANCES = 255
End Enum

Public Function InitializePipe(Optional sPipeNameSuffix As String = "vbaPipedVariantArrays") As Boolean
    Const csPipeNamePrefix As String = "\\.\pipe\"
    CleanUp
   
    Dim sPipeName As String
    sPipeName = csPipeNamePrefix & sPipeNameSuffix
   
    '* Must call CreateNamedPipe first before calling Open <<pathname>> For Binary otherwise you get bad file number
    mhPipe = CreateNamedPipeW(StrPtr(sPipeName), PIPE_ACCESS_DUPLEX, PIPE_TYPE_BYTE + PIPE_READMODE_BYTE + PIPE_WAIT, _
            PIPE_UNLIMITED_INSTANCES, -1, -1, 0, 0)
           
    If mhPipe = -1 Then mhPipe = 0 'reset from InvalidHandleValue to "no Handle"
   
    If mhPipe Then
        '* only try to find a free VB-FileNumber when mhPipe is valid (i.e. pipe has been created)
        mlFileNumber = FreeFile
        If mlFileNumber Then
            Open sPipeName For Binary As mlFileNumber  'open only, when we got an mlFileNumber
        End If
    End If
   
    InitializePipe = mhPipe <> 0 And mlFileNumber <> 0
End Function

Public Function SerializeToBytes(ByRef vSrc As Variant, ByRef pabytSerialized() As Byte) As Long

    Dim lBytesAvail As Long

    Debug.Assert IsArray(vSrc)

    If mlFileNumber <> 0 Then
   
        '* this next line writes the Variant array to the pipe
        Put mlFileNumber, 1, vSrc
       
        '* we should now have some bytes to read out of the pipe, use PeekNamedPipe to verify there are bytes available
        PeekNamedPipe mhPipe, ByVal 0&, 0, ByVal 0&, lBytesAvail, 0
       
        If lBytesAvail > 0 Then
           
            '* so now we can dimension the byte array
            ReDim Preserve pabytSerialized(0 To lBytesAvail - 1)
           
            '* and now we can read the bytes out of the pipe and into the byte array
            ReadFile mhPipe, pabytSerialized(0), lBytesAvail, lBytesAvail, ByVal 0&
           
            '* return number of bytes as a courtesy (not actually required)
            SerializeToBytes = lBytesAvail
        End If
    End If
End Function

Public Function DeserializeFromBytes(ByRef abytSerialized() As Byte, ByRef pvDest As Variant) As Long
   
    Dim lBytesWritten As Long
   
    If mhPipe <> 0 And mlFileNumber <> 0 Then

        '* write the byte array to the pipe
        WriteFile mhPipe, abytSerialized(0), UBound(abytSerialized) + 1, lBytesWritten, 0
       
        If lBytesWritten = UBound(abytSerialized) + 1 Then
            '* the pipe contains a byte array serialization of a variant array
            '* we can use VBA's Get statement to read it directly into a variant array variable
            Get mlFileNumber, 1, pvDest
           
            '* report the amount of deserialized Bytes as a courtesy (not actually required)
            DeserializeFromBytes = Loc(mlFileNumber)
        End If
    End If
End Function

Private Sub CleanUp()
    If mlFileNumber Then Close mlFileNumber: mlFileNumber = 0
    If mhPipe Then DisconnectNamedPipe mhPipe
    If mhPipe Then CloseHandle mhPipe: mhPipe = 0
End Sub

Private Sub Class_Terminate()
    CleanUp
End Sub

VBA Standard Module - tstPipedVariants

So now we need some client code. Add a standard module to your VBA project and paste in the following code. I called this module tstPipedVariants.

Sub SamePipeForSerializeAndDeserialize()
    Dim oPipe As cPipedVariants
    Set oPipe = New cPipedVariants
   
    If oPipe.InitializePipe Then
        Dim vSource As Variant
        vSource = TestData

        Dim abytSerialized() As Byte

        Call oPipe.SerializeToBytes(vSource, abytSerialized)

        Stop '* at this point vSource is populated but vDestination is empty

        Dim vDestination As Variant
        oPipe.DeserializeFromBytes abytSerialized, vDestination
   
        Stop
    End If
End Sub

Function TestData() As Variant
    Dim vSource(1 To 2, 1 To 4) As Variant
    vSource(1, 1) = "Hello World"
    vSource(1, 2) = True
    vSource(1, 3) = False
    vSource(1, 4) = Null
    vSource(2, 1) = 65535
    vSource(2, 2) = 7.5
    vSource(2, 3) = CDate("12:00:00 16-Sep-1989") 'now()
    vSource(2, 4) = CVErr(xlErrNA)
    TestData = vSource
End Function

In the module tstPipedVariants run the test code subroutine SamePipeForSerializeAndDeserialize() by navigating and pressing F5 to reach the first Stop statement. On the first Stop statement vSource is populated but vDestination isn’t.

However, the byte array abytSerialized() is populated and we can go inspect this. The first twenty bytes are similar to SafeArray and SafeArrayBounds structures. The first two bytes represent a vbVarType of vbArray+vbVariant in low byte, high byte order. Next, two bytes gives the count of dimensions. Then for each dimension there are 8 bytes, giving a 4 byte dimension size and a 4 byte lower bound. This abridged SafeArray descriptor is most welcome. When VBA code writes a variant array to disk it omits such a descriptor which meant I had to augment the code to manually write in the dimensions. I am very much pleased that the Named Pipes implementation does this automatically for me.

After the first twenty bytes of abridged SafeArray descriptor the rest of the data follows. I wrote this up in the original blog post so I’ll refer you to that and skip the rest.

Returning to the test code, press F5 again to get the second Stop statement and behold in the Locals window the vDestination variable is now populated exactly the same as the vSource variable. Note how we did not need to dimension the vDestination variable before populating it, excellent!

This completes the VBA to VBA demo. We can move onto the JavaScript to VBA use case.

Revisiting the Javascript to VBA use case

JavaScript Changes

In the original article I gave some Javascript code to serialize a Javascript array to a byte array that can then be deserialized to a VBA variant array. This JavaScript code needs modifying to interoperate with the new Named Pipes VBA code given above. The change required is to give a correctly formatted abridged safe array descriptor. This is a simple change found at the top of the JavaScriptToVBAVariantArray.prototype.persistGrid function. All other code remains the same, so no further explanation is required. The JavaScript module remains something loadable into both browser and server JavaScript environments. The Node.js project given in the original blog post can still be used.

I have only included the function that has changed, JavaScriptToVBAVariantArray.prototype.persistGrid; for rest of the JavaScript module listing see the original blog post.

JavaScriptToVBAVariantArray.prototype.persistGrid = function persistGrid(grid, rows, columns) {
	try {
		/* Opening sequence of bytes is a reduced form of SAFEARRAY and SAFEARRAYBOUND
		 * SAFEARRAY       https://docs.microsoft.com/en-gb/windows/win32/api/oaidl/ns-oaidl-safearray
		 * SAFEARRAYBOUND  https://docs.microsoft.com/en-gb/windows/win32/api/oaidl/ns-oaidl-safearraybound
		 */

		var payloadEncoded = new Uint8Array(20);

		// vbArray + vbVariant, lo byte, hi byte
		payloadEncoded[0] = 12; payloadEncoded[1] = 32;

		// number of dimensions, lo byte, hi byte
		payloadEncoded[2] = 2; payloadEncoded[3] = 0;

		// number of columns, 4 bytes, least significant byte first
		payloadEncoded[4] = columns % 256; payloadEncoded[5] = Math.floor(columns / 256);
		payloadEncoded[6] = 0; payloadEncoded[7] = 0;

		// columns lower bound (safearray)
		payloadEncoded[8] = 1; payloadEncoded[9] = 0;
		payloadEncoded[10] = 0; payloadEncoded[11] = 0;

		// number of rows, 4 bytes, least significant byte first
		payloadEncoded[12] = rows % 256; payloadEncoded[13] = Math.floor(rows / 256);
		payloadEncoded[14] = 0; payloadEncoded[15] = 0;

		// rows lower bound (safearray)
		payloadEncoded[16] = 1; payloadEncoded[17] = 0;
		payloadEncoded[18] = 0; payloadEncoded[19] = 0;

		var elementBytes;
		for (var colIdx = 0; colIdx < columns; colIdx++) {
			for (var rowIdx = 0; rowIdx < rows; rowIdx++) {
				elementBytes = this.persistVar(grid[rowIdx][colIdx]);
				var arr = [payloadEncoded, elementBytes];

				payloadEncoded = this.concatArrays(arr); // Browser
			}
		}
		return payloadEncoded;
	}
	catch (err) {
		console.log(err.message);
	}
};

VBA web client code

Turning to the client VBA code we can greatly simplify the code now that the dimensioning is done for us. The resulting code is now trivial, here it is below. Add the following code to the tstPipedVariants module you added earlier. This code below requires you to add a Tools->Reference to Microsoft WinHTTP Services, version 5.1...

Sub TestByWinHTTP()
    '* this calls the Node.js project with the new JavaScript serialization
    Dim oWinHttp As WinHttp.WinHttpRequest '* Tools->References->Microsoft WinHTTP Services, version 5.1
    Set oWinHttp = New WinHttp.WinHttpRequest
    oWinHttp.Open "GET", "http://localhost:1337/", False
    oWinHttp.send
   
    If oWinHttp.Status = 200 Then
        If IsEmpty(oWinHttp.ResponseBody) Then Err.Raise vbObjectError, , "No bytes returned!"
        If UBound(oWinHttp.ResponseBody) = 0 Then Err.Raise vbObjectError, , "No bytes returned!"
       
        Dim oPipedVariants As cPipedVariants
        Set oPipedVariants = New cPipedVariants
        If oPipedVariants.InitializePipe Then
       
            Dim vGrid As Variant
            oPipedVariants.DeserializeFromBytes oWinHttp.ResponseBody, vGrid
           
            Stop '* Observe vGrid in the Locals window
           
            '* vGrid is now ready to paste on a worksheet
        End If
    End If
End Sub

So run this code with the Node.js project running and the vGrid should be populated. That's all folks. Enjoy!

Thanks again

Thanks once again to Olaf Schmidt and the anonymous tipper! Getting help to fix my code is very welcome.

VBA calling Python calling back into VBA

In this post I again show a Python COM gateway class callable from VBA; this time it demonstrates calling back into the VBA using Application.Run, ThisWorkbook or a VBA-defined class. It does this by ensuring a win32com.client.Dispatch wrapper. It also demonstrates code to report all the local variables for debugging purposes. Further, it demonstrates running the COM server in a separate process.

Calling back using COM

So, I need some code to callback into VBA from a Python COM component, the mechanism will clearly be another COM call. Let's list the COM ways we can do this...

1. Pass in the Excel.Application object and call Application.Run with the name of a macro to callback on.
2. Write callback code in the ThisWorkbook module and pass in the Workbook object and have Python call a method in the workbook's ThisWorkbook module.
3. Write callback code in a VBA defined class and pass in instance of such a class and have Python call a method on that instance.
4. Write code to implement COM events, i.e. a source interface and declare a variable in VBA using the WithEvents keyword to sink the events.

I have implemented the top three in the code below. If you want COM events you'll need a Type Library, but Python does not supply one automatically; I did write some code to use Python reflection to generate a type library but this is not out of the box functionality from Python. Never mind, a callback routine in Excel could itself raise events if you really wants events; after all, COM events are simply callbacks to multiple listeners instead of a single listener.

For some very odd reason the third case, the VBA defined case had a bug/glitch. It would report not just the return value but instead a tuple of the return value and all the input parameters. This is a pitfall but easily solved and not a problem once one is aware that the problem exists.

Ensure Dispatch

The key tip in the code with regard to calling back is to wrap whatever is passed in from VBA in a win32com.client.Dispatch wrapper. In testing however, sometimes I use an object which I have acquired from the Running Object Table which already comes wrapped. So I wrote a small class called the DispatchEnsurer to inspect what it has been given and wrap where necessary.

Inability to Attach the Microsoft Visual Studio debugger

So I am embarrassed to admit I cannot get the Microsoft Visual Studio debugger to attach to the Excel session and specifically hit breakpoints in my Python code. This means stepping through the code as initiated by a call from Excel VBA is impossible. If you know how to do this please leave a comment. In the meantime I had to write a class to report all the local variables for a method into a nicely formatted string and pass that back to the calling VBA so I can see what is going on (see below). I would point out that it is still possible to acquire a workbook object from the running object table using win32com.client.GetObject(<<workbook full file path>>) and that is primarily how one can get around this problem.

Perhaps I should report this breakpoint problem as a bug to Microsoft's Visual Studio team. I do not believe it is Python's fault.

Declarative Python COM server registration

So the breakpoint problem above was quite painful. Another painful problem was updating the Python script and have Excel VBA pick up the changes. In some instances I had to change the COM's class's CLSID to force the Excel VBA client code to pick up the script changes. Other tactics involved shutting down Excel and reopening but this didn't always work as I believe there is some sort of session recycling (I'll investigate this at some point). Anyway, I found the best way for rapid iterative development without re-registering and without rebooting Excel was to make the Python COM server sit in a separate process and then kill that process to pick up script changes.

Getting a COM server to sit in its own process requires adding the following line of code to your Python COM gateway class

_reg_clsctx_ = pythoncom.CLSCTX_LOCAL_SERVER

Adding one single line of source to effect this change is quite impressive. To get C# to do this requires a degree of fiddling around in the registry plus some extra code, so Python deserves praise for this declarative simplicity.

With this extra line of code the Python executables will not be loaded into the Excel.exe process but instead loaded into a pythonw.exe process. So this means we can kill the pythonw.exe process and force Excel VBA/COM runtime to spawn a new one that will effect any new script changes. Here is some VBA code to kill the pythonw.exe process...

Sub PickupNewPythonScript()
    '# for development only to help pick up script changes we kill the python process
    Call CreateObject("WScript.Shell").Run("taskkill /f /im pythonw.exe", 0, True)
End Sub

So with the ability to kill the Python process and force it to pick up new changes without rebooting Excel and without incrementing CLSIDs and re-registering meant I could start to get some work done!

Reporting all the local variables

As mentioned above without the ability to step through the code one loses the ability to see the values of the local variables. Luckily and to Python's credit there is a locals() dictionary which contains all the local variables; we can print this although I added some extra line breaking and formatting. I give a formatting class in the code below. I use this to return all the local variables when an error occurs. This allows me to debug in the absence of proper/formal debugger support.

VBA Class use case returns tuple of return value and input arguments

I can only assume that this is a bug or a glitch but in the case of the VBA defined class I found that the return value was returned in a tuple that also consisted on the input arguments. Not a real problem as we simply access the tuple's first element with [0].

Python Code

The Python code is one single listing. Run this within Microsoft Visual Studio or from the command line. One needs to run it at least once to register the COM class registration. If you run without Administrator privileges it will request to elevate.

import win32com.server.register
from win32com.client import Dispatch
import pythoncom

class CallingBackIntoVBA(object):
    _reg_clsid_ = "{352B1FE3-8F8E-478B-93D0-A5AAC612D09A}"
    _reg_progid_ = 'PythonInVBA.CallingBackIntoVBA'
    _reg_desc_ = "Demonstrates a Python COM server calling back into calling VBA code"
    _public_methods_ = ['DemoAppRunCallback','DemoThisWorkbookCallback', 'DemoClassCallback']
    _reg_clsctx_ = pythoncom.CLSCTX_LOCAL_SERVER

    def DemoClassCallback(self, classInstance, arg0=None, arg1=None, arg2=None):
        try:
            dispCb = DispatchEnsurer.EnsureDispatch(classInstance)

            # for some reason a tuple of the return value and arguments is
            # returned, very odd!!
            return dispCb.ClassCallback2(arg0,arg1,arg2)[0]  # [0] gets first element of the tuple

        except Exception as ex:
            return LocalsEnhancedErrorMessager.Enhance(ex,str(locals()))

    def DemoAppRunCallback(self,excelApplication, appRunMacro: str, arg0=None, arg1=None, arg2=None):
        try:
            dispApp = DispatchEnsurer.EnsureDispatch(excelApplication)
            return dispApp.Run(appRunMacro, arg0,arg1,arg2)

        except Exception as ex:
            return LocalsEnhancedErrorMessager.Enhance(ex,str(locals()))

    def DemoThisWorkbookCallback(self, workbook, arg0=None, arg1=None, arg2=None):
        try:
            dispWb = DispatchEnsurer.EnsureDispatch(workbook)
            #dispWb.madeUpName()
            return dispWb.ThisWorkbookCallback2(arg0,arg1,arg2)

        except Exception as ex:
            return LocalsEnhancedErrorMessager.Enhance(ex,str(locals()))

class LocalsEnhancedErrorMessager(object):
    @staticmethod
    def Enhance(ex, localsString):
        locals2 = "n Locals:{ " + (",n".join(localsString[1:-1].split(",")) ) + " }"
        if hasattr(ex,"message"):
            return "Error:" + ex.message + locals2
        else:
            return "Error:" + str(ex) + locals2

class DispatchEnsurer(object):
    @staticmethod
    def EnsureDispatch(comObj):
        """ Sometimes we get a PyIDispatch so we'll need to wrap it, this class takes care of that contingency"""
        try:
            dispApp = None
            apptypename = str(type(comObj))
            if apptypename == "<class 'win32com.client.CDispatch'>":
                # this call from GetObject so no need to Dispatch()
                dispApp = comObj
            elif apptypename == "<class 'PyIDispatch'>":
                # this was passed in from VBA so wrap in Dispatch
                dispApp = Dispatch(comObj)
            else:
                # other cases just attempt to wrap
                dispApp = Dispatch(comObj)
            return dispApp 
        except Exception as ex:
            if hasattr(ex,"message"):
                return "Error:" + ex.message 
            else:
                return "Error:" + str(ex)

def RegisterCOMServers():
    print("Registering COM servers...")
    import win32com.server.register
    win32com.server.register.UseCommandLine(CallingBackIntoVBA)

def TestCallingBackIntoVBA():
    import win32com
    cb = CallingBackIntoVBA()
    wb = win32com.client.GetObject(r"C:\Users\Simon\Downloads\PythonVBACallbackDemo.xlsm")
    app = wb.Parent
    sb = app.StatusBar

    ret = cb.DemoAppRunCallback(app,"PythonVBACallbackDemo.xlsm!Module1_Proc1",0,1,2)
    print(ret)

if __name__ == '__main__':
    pass
    RegisterCOMServers()
    #TestCallingBackIntoVBA()

VBA Code Listings

Whereas the Python code is a single listing the VBA code is in contrast dispersed across several modules, please place into one workbook. I called mine PythonVBACallbackDemo.xlsm.

ThisWorkbook module

Place the following code in the ThisWorkbook module

Public Function ThisWorkbookCallback1()
    Debug.Print "ThisWorkbookCallback1"
End Function

Public Function ThisWorkbookCallback2(arg0, arg1, arg2)
    ThisWorkbookCallback2 = CStr(arg0) & " " & CStr(arg1) & " " & CStr(arg2)
    Debug.Print "ThisWorkbook.ThisWorkbookCallback2"
End Function

Callback Class

Place the following code in a VBA class named Callback with its Instancing type set to 2 - PublicNotCreatable

Public Function ClassCallback1()
    Debug.Print "ClassCallback1"
End Function

Public Function ClassCallback2(arg0, arg1, arg2) As String
    ClassCallback2 = CStr(arg0) & " " & CStr(arg1) & " " & CStr(arg2)
    Debug.Print "Callback.ClassCallback2"
End Function

Standard module code

Place the following code in a standard (non-class module), it doesn't matter what you name this module but I called mine modCallbackDemos . The procedures to run (by placing cursor and pressing F5) are ThisWorkbookCallbackDemo(), AppRunMacroDemo() and ClassCallbackDemo().

Option Explicit

Sub PickupNewPythonScript()
    '# for development only to help pick up script changes we kill the python process
    Call CreateObject("WScript.Shell").Run("taskkill /f /im pythonw.exe", 0, True)
End Sub

Sub ThisWorkbookCallbackDemo()
    Dim obj As Object
    Set obj = VBA.CreateObject("PythonInVBA.CallingBackIntoVBA")
    
    Debug.Print obj.DemoThisWorkbookCallback(ThisWorkbook, 0, 1, 2)
    
    Set obj = Nothing
End Sub

Sub AppRunMacroDemo()
    'Stop
    Dim obj As Object
    Set obj = VBA.CreateObject("PythonInVBA.CallingBackIntoVBA")
    
    Dim sAppRunMacro As String
    sAppRunMacro = ThisWorkbook.Name & "!Module1_Proc1"
    
    Dim vRet As Variant
    vRet = obj.DemoAppRunCallback(Application, sAppRunMacro, 0, 1, 2)
    Debug.Print vRet
    
    Set obj = Nothing
End Sub

Function Module1_Proc1(arg0, arg1, arg2)
    Dim sRet
    sRet = "Module1_Proc1 running"
    Debug.Print sRet
    Module1_Proc1 = sRet & " foobar"
End Function

Sub ClassCallbackDemo()
    Dim obj As Object
    Set obj = VBA.CreateObject("PythonInVBA.CallingBackIntoVBA")
    
    Dim oCallback As Callback
    Set oCallback = New Callback
    
    Debug.Print obj.DemoClassCallback(oCallback, 0, 1, 2)
    
    Set obj = Nothing
End Sub

So if I run ThisWorkbookCallbackDemo() then the expected output is

ThisWorkbook.ThisWorkbookCallback2
0 1 2

And if I run AppRunMacroDemo() then the expected output is

Module1_Proc1 running
Module1_Proc1 running foobar

And finally if I run ClassCallbackDemo() then the expected output is

Callback.ClassCallback2
0 1 2

Amending the script and picking up changes

So in the above code listing there is a routine PickupNewPythonScript() which I use to avoid having to reboot Excel. You might like to experiment with it, so make a change in the Python script, save your Python script changes then run PickupNewPythonScript() and see your changes effected. I have added a commented out line of code in the Python script

#dispWb.madeUpName()

which if uncommented and effected will mean the expected output of running ThisWorkbookCallbackDemo() changes to

Error:<unknown>.madeUpName
 Locals:{ 'self': <CallingBackIntoVBA.CallingBackIntoVBA object at 0x030224D0>,
 'workbook': <PyIDispatch at 0x009EDF70 with obj at 0x009301BC>,
 'arg0': 0,
 'arg1': 1,
 'arg2': 2,
 'dispWb': <COMObject <unknown>>,
 'ex': AttributeError('<unknown>.madeUpName') }

thus demonstrating the local variables report.

Enjoy!

Final thoughts

If I could express a preference for which pattern to use I would pass in the Excel Application and use Application.Run. This is because the Application object is most durable. After all, workbooks can be unloaded meaning the callback target could go missing and you are calling on a null (stale) pointer. Moreover, an instance of a VBA class is even more temporary in that class instances can be torn down during a state loss.

I am pleased about running the Python COM server in a separate process and then killing it to spawn a refreshed and updated new instance picking up code changes. This is a major productivity boon.

Javascript - Binary representation of VBA's Variant Array

I am delighted to give a world first in this post where I give JavaScript code to convert a JavaScript array into a byte array loadable into a VBA variant array. This gives an efficient binary serialization format for web services and other network calls where the end client is VBA and especially Excel worksheet cells.

Following on from the previous post where I document an undocumented file serialization format used by VBA with the FreeFile, Open For Binary and Put statements. I can now go on to give some JavaScript to convert two dimensional JavaScript arrays containing JavaScript variables therein to a byte array directly loadable by VBA into a variant array.

This now means a VBA client need not consume Xml or JSON when calling a web service. This is a big win because both Xml and JSON are string based and require parsing into data structures which is expensive. The Xml needs further code to interrogate the nodes with XPath etc. If the end destination for the data is the worksheet then the variant array can be directly pasted into cells (some code is give below).

To get VBA client code to do less work requires the server-side code to do more work. A JavaScript module, JavaScriptToVBAVariantArray.js, is given below which converts JavaScript arrays and variables into a byte array directly loadable by VBA (save for an few initial bytes conveying number of rows and columns).

As well the key JavaScript module, JavaScriptToVBAVariantArray.js, I also give some Node.js server-side JavaScript code to implement a web service that demonstrates the byte array being communicated to a VBA client.

JavaScriptToVBAVariantArray.js - module common to browser and server

So the following JavaScript module is usable in both the browser client and a Node.js server. It encapsulates all the logic to convert a two dimensional (block not nested) JavaScript array containing primitives of strings, Booleans, dates and numbers to a byte array loadable by VBA into a Variant array ready to be pasted onto a worksheet. Also included is logic to take a JavaScript Error object and convert this to an Excel worksheet error code so one can transmit #REF!, #N/A! and #NAME? errors.

The code is implemented as a prototyped class, it includes two test methods JavaScriptToVBAVariantArray.testPersistVar and JavaScriptToVBAVariantArray.testPersistGrid to demonstrate the code's usage. The remaining methods contain production logic that utilize ArrayBuffers and collaborating classes Float64Array and Uint8Array.

So the following code to be saved to its own separate file called JavaScriptToVBAVariantArray.js which then should be added to a Node.js project. I am using Microsoft Visual Studio for a development environment.

'use strict';

// module exporting for node.js and browsers with thanks to
// https://www.matteoagosti.com/blog/2013/02/24/writing-javascript-modules-for-both-browser-and-node/

(function () {
    var JavaScriptToVBAVariantArray = (function () {
        var JavaScriptToVBAVariantArray = function (options) {
            var pass; //...
        };


        JavaScriptToVBAVariantArray.prototype.testPersistVar = function testPersistVar() {
            try {
                var payload;
                //payload = "Hello World";
                //payload = false;
                //payload = 655.35;
                payload = new Date(1989, 9, 16, 12, 0, 0);
                var payloadEncoded = persistVar(payload);
                return payloadEncoded;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.testPersistGrid = function testPersistGrid() {
            try {
                var rows = 2;
                var columns = 4;
                var arr = this.createGrid(rows, columns);
                arr[0][0] = "Hello World";
                arr[0][1] = true;
                arr[0][2] = false;
                arr[0][3] = null;

                arr[1][0] = 65535;
                arr[1][1] = 7.5;
                arr[1][2] = new Date(1989, 9, 16, 12, 0, 0);
                arr[1][3] = new Error(2042);

                var payloadEncoded = this.persistGrid(arr, rows, columns);
                return payloadEncoded;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistGrid = function persistGrid(grid, rows, columns) {
            try {

                var payloadEncoded = new Uint8Array(4);
                payloadEncoded[0] = rows % 256; payloadEncoded[1] = Math.floor(rows / 256);
                payloadEncoded[2] = columns % 256; payloadEncoded[3] = Math.floor(columns / 256);
                var elementBytes;
                for (var colIdx = 0; colIdx < columns; colIdx++) {
                    for (var rowIdx = 0; rowIdx < rows; rowIdx++) {
                        elementBytes = this.persistVar(grid[rowIdx][colIdx]);
                        var arr = [payloadEncoded, elementBytes];

                        payloadEncoded = this.concatArrays(arr); // Browser
                    }
                }
                return payloadEncoded;
            }
            catch (err) {
                console.log(err.message);
            }
        };


        JavaScriptToVBAVariantArray.prototype.concatArrays = function concatArrays(arrays) {
            // With thanks to https://javascript.info/arraybuffer-binary-arrays


            // sum of individual array lengths
            let totalLength = arrays.reduce((acc, value) => acc + value.length, 0);

            if (!arrays.length) return null;

            let result = new Uint8Array(totalLength);

            // for each array - copy it over result
            // next array is copied right after the previous one
            let length = 0;
            for (let array of arrays) {
                result.set(array, length);
                length += array.length;
            }

            return result;
        };

        JavaScriptToVBAVariantArray.prototype.createGrid = function createGrid(rows, columns) {
            try {
                return Array.from(Array(rows), () => new Array(columns));
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistVar = function persistVar(v) {
            try {

                if (v === null) {
                    // return a Null
                    var nullVt = new Uint8Array(2);
                    nullVt[0] = 1;
                    return nullVt;

                } else if (v instanceof Error) {

                    return this.persistError(v);

                } else if (typeof v === 'undefined') {
                    return new Uint8Array(2); // return an Empty

                } else if (typeof v === "boolean") {
                    // variable is a boolean
                    return this.persistBool(v);
                } else if (typeof v.getMonth === "function") {
                    // variable is a Date
                    return this.persistDate(v);
                } else if (typeof v === "string") {
                    // variable is a boolean
                    return this.persistString(v);
                } else if (typeof v === "number") {
                    // variable is a number
                    return this.persistNumber(v);
                }

            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistError = function persistError(v) {
            try {
                var errorVt = new Uint8Array(6); // return a vtError
                errorVt[0] = 10; errorVt[4] = 10; errorVt[5] = 128;

                var errorNumber;
                try {
                    errorNumber = parseInt(v.message);
                }
                catch (err) {
                    errorNumber = 2000;
                    console.log(err.message);
                }
                errorVt[2] = errorNumber % 256; errorVt[3] = Math.floor(errorNumber / 256);

                return errorVt;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistNumber = function persistNumber(v) {
            try {
                var bytes;
                if (Number.isInteger(v)) {
                    bytes = new Uint8Array(6);
                    bytes[0] = 3; bytes[1] = 0;  // VarType 5 = Long
                    bytes[2] = v % 256; v = Math.floor(v / 256);
                    bytes[3] = v % 256; v = Math.floor(v / 256);
                    bytes[4] = v % 256; v = Math.floor(v / 256);
                    bytes[5] = v % 256;

                } else {
                    bytes = this.persistDouble(v, 5);
                }
                return bytes;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistDate = function persistDate(v) {
            try {
                // convert JavaScript 1970 base to VBA 1900 base
                // https://stackoverflow.com/questions/46200980/excel-convert-javascript-unix-timestamp-to-date/54153878#answer-54153878
                var xlDate = v / (1000 * 60 * 60 * 24) + 25569;
                return this.persistDouble(xlDate, 7);
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistDouble = function persistDouble(v, vt) {
            try {
                var bytes;
                bytes = new Uint8Array(10);
                bytes[0] = vt; bytes[1] = 0;  // VarType 5 = Double or 7 = Date
                var doubleAsBytes = this.doubleToByteArray(v);
                for (var idx = 0; idx < 8; idx++) {
                    bytes[2 + idx] = doubleAsBytes[idx];
                }
                return bytes;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.doubleToByteArray = function doubleToByteArray(number) {
            try {
                // https://stackoverflow.com/questions/25942516/double-to-byte-array-conversion-in-javascript/25943197#answer-39515587
                var buffer = new ArrayBuffer(8);         // JS numbers are 8 bytes long, or 64 bits
                var longNum = new Float64Array(buffer);  // so equivalent to Float64

                longNum[0] = number;

                return Array.from(new Int8Array(buffer));
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistString = function persistString(v) {
            try {
                var strlen = v.length;
                var bytes = new Uint8Array(strlen + 4);
                bytes[0] = 8; bytes[1] = 0;  // VarType 8 = String
                bytes[2] = strlen % 256; bytes[3] = Math.floor(strlen / 256);
                for (var idx = 0; idx < strlen; idx++) {
                    bytes[idx + 4] = v.charCodeAt(idx);
                }
                return bytes;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistBool = function persistBool(v) {
            try {
                var bytes = new Uint8Array(4);
                bytes[0] = 11; bytes[1] = 0;   // VarType 11 = Boolean
                if (v === true) {
                    bytes[2] = 255; bytes[3] = 255;
                } else {
                    bytes[2] = 0; bytes[3] = 0;
                }
                return bytes;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        return JavaScriptToVBAVariantArray;
    })();

    if (typeof module !== 'undefined' && typeof module.exports !== 'undefined')
        module.exports = JavaScriptToVBAVariantArray;
    else
        window.JavaScriptToVBAVariantArray = JavaScriptToVBAVariantArray;
})();

Node.js server code

The following code should is for running in Node.js. Start with a new Blank Node.js Web Application project in Microsoft Visual Studio, add the JavaScriptToVBAVariantArray.js module listed above. In the server.js file replace the code with the listing below. Running the project should spawn a new browser and then print something like the following, i.e. a mix of printable and non-printable characters; this is a browser attempting to display the generated byte array.

    Hello World ÿÿ ÿÿ  @  «ªªª® à@  ú  €

'use strict';

{
    try {
        var JavaScriptToVBAVariantArray = require('./JavaScriptToVBAVariantArray');
        var v = new JavaScriptToVBAVariantArray();
        var payloadEncoded = v.testPersistGrid();
    }
    catch (err) {
        console.log('Could not find JavaScriptToVBAVariantArray.js module:' + err.message);
    }
}

require('http').createServer(function (req, res) {
    try {
        var q = require('url').parse(req.url, true);
        if (q.pathname === '/') {
            /* it's the request for our serialized Variant array */
            res.writeHead(200, { 'Content-Type': 'text/html' });

            // https://stackoverflow.com/questions/8609289/convert-a-binary-nodejs-buffer-to-javascript-arraybuffer
            var buffer = Buffer.from(new Uint8Array(payloadEncoded));
            res.end(buffer);
        }
        else {
            var filename = "." + q.pathname;
            var fs = require('fs');
            fs.readFile(filename, function (err, data) {
                if (err) {
                    res.writeHead(404, { 'Content-Type': 'text/html' });
                    return res.end("404 Not Found");
                }
                res.writeHead(200, { 'Content-Type': 'text/html' });
                res.write(data);
                return res.end();
            });
        }
    }
    catch (err) {
        console.log(err.message);
    }
}).listen(process.env.PORT || 1337);

HTMLPage.html (optional)

I intend the end client to be VBA as we are demonstrating how to serialize to a byte array loadable by VBA. Nevertheless, I include an HTML page to prove the JavaScript works in the browser. Also, if one follows the instructions on the web page and one opens the Dev Tools and the Console then one can see the byte array is a more readily viewable form (or at least more viewable that the non-printable characters above). Once this is added to your Node.js project then in a browser you can type the url http://localhost:1337/HtmlPage.html to access the page.

<!DOCTYPE html>

<html xmlns="http://www.w3.org/1999/xhtml">
<head>
    <meta charset="utf-8" />
    <title></title>
</head>
<body>
    <p>
        <span style="font-family:Courier New, Courier, monospace">
            Look in the console!
            Do this by right-click menu and then Inspect to get the DevTools window
            then click on the Console tab
        </span>
    </p>
    <script src="https://raw.githubusercontent.com/arextar/browser-buffer/master/browser-buffer.min.js"></script>
    <script src="JavaScriptToVBAVariantArray.js"></script>
    <script>
        var v = new JavaScriptToVBAVariantArray();
        var payloadEncoded = v.testPersistGrid();
        console.log(payloadEncoded);
    </script>
</body>
</html>

Client VBA Code

Finally, we get to the VBA client code. Paste this into a standard module, you will need some code from the previous post. You will also need a Tools->Reference to Microsoft WinHTTP Services, version 5.1 to make the HTTP call.

So the listing below will call into the Javascript web service given above, it takes the HTTP response and then reads the rows and columns from the first four bytes, the remaining bytes it will write to a temporary file (this could be speeded with the use of a RAM disk). The temporary file is then read directly into a variant array new dimensioned with the correct rows and columns.

At this point any VBA code can work with this variant array like it was any other as the byte array has been converted to a VBA native data structure! The code below goes on to paste the variant array to a block of cells on a worksheet (please save your work as this overwrites the cells).

In the pasted cells (screenshot given) we can see a string, two booleans, a deliberately empty cell, an integer, a decimal number, a date, and a #N/A worksheet error code. This demonstrates the full range of variable types that can be transmitted via the byte array.

Sub TestByWinHTTP()
    Dim WinHttp As WinHttp.WinHttpRequest '* Tools->References->Microsoft WinHTTP Services, version 5.1
    Set WinHttp = New WinHttp.WinHttpRequest
    WinHttp.Open "GET", "http://localhost:1337/", False
    WinHttp.send
    
    If WinHttp.Status = 200 Then
        If IsEmpty(WinHttp.responseBody) Then Err.Raise vbObjectError, , "No bytes returned!"
        If UBound(WinHttp.responseBody) = 0 Then Err.Raise vbObjectError, , "No bytes returned!"
        
        '**** SAVE ****
        Dim lSaveFileNum As Long
        Dim sFullFilename As String
        sFullFilename = OpenCleanFileForBinary("JavascriptToVBABin.bin", lSaveFileNum)
        
        
        Dim lRows As Long, lColumns As Long
        lRows = WinHttp.responseBody(0) + WinHttp.responseBody(1) * 256
        lColumns = WinHttp.responseBody(2) + WinHttp.responseBody(3) * 256
        
        Dim lByteLoop As Long
        For lByteLoop = 4 To UBound(WinHttp.responseBody)
            Put lSaveFileNum, , CByte(WinHttp.responseBody(lByteLoop))
        Next lByteLoop
        Close lSaveFileNum
        
        '**** LOAD ****
        
        ReDim vGrid(0 To lRows - 1, 0 To lColumns - 1) As Variant
        Dim lLoadFileNum As Long
        lLoadFileNum = OpenFileForBinary(sFullFilename)
        Get lLoadFileNum, , vGrid
        Close lLoadFileNum
        
        '**** WRITE TO WORKSHEET CELLS ****
        
        Stop '* next line will overwrite cells!! please save your work!!
        Sheet1.Range("a11").Resize(lRows, lColumns).Value = vGrid
        Stop '* Observe the cells on the worksheet
    End If
End Sub

Final Thoughts

It is a shame that the serialization format does not natively include the dimensions of the array block/grid as I could shave even more lines of code on the VBA side. It is also a shame we have to write the file to disk instead of being able to load directly into memory; there is the option of using a RAM disk to speed the file operation. In the meantime I feel I can write JavaScript Chrome extensions that could now transmit blocks of cells to an Excel client in VBA's native serialization format. Cool!