VBA - Python - Type Library Finder - use reflection to find a late bound object's containing library

I love finding rare stuff that works in Excel VBA, this blog is full of it! I love finding new useful type libraries of classes which drive functionality I didn't know was possible for a VBA developer. They turn up infrequently on Stack Overflow and other forum websites. Often the sample code creates an object using late binding and not with the type library. When I discover one of these I instantly want to find the containing type library to see what else is in that library. Such an investigation requires

1. Looking up the ProgID (the text string passed to CreateObject()) to get a CLSID
2. Looking up the CLSID to get the LIBID, the type library's guid
3. Looking up the LIBID to get the type library's full name

So for example an interesting component is created with CreateObject("WIA.ImageFile") that has a clsid of {A2E6DDA0-06EF-4df3-B7BD-5AA224BB06E8}, and type library guid of {94A0E92D-43C0-494E-AC29-FD45948A5221} which has the full name of Microsoft Windows Image Acquisition Library v2.0.

Combing though the registry is a pain so fortunately we can write some Python code and use the reflection interfaces, ITypeInfo and ITypeLib which are usually restricted to C++ developers but which Python developers have access to and in turn we can expose to Excel VBA code.

Below is a Python COM Gateway class, I have supplied many examples on this blog so the procedure should be familiar (to regular readers at least). But to recap you need to run the following script with adminstrator privileges from a command console. Once registered, the class becomes creatable from VBA using CreateObject.

class WhichTypeLibrary(object):
    _reg_clsid_ = "{521B0A5A-4359-4874-AA9E-8F99DB35F4A6}"
    _reg_progid_ = 'PythonInVBA.WhichTypeLibrary'
    _public_methods_ = ['ReportTypeLibrary'] 

    def ReportTypeLibrary(self, o):
        try:
            pt = str(type(o))
            if pt == "<class 'win32com.client.CDispatch'>":
                ti = o._lazydata_[0]
            elif pt == "<class 'PyIDispatch'>" :
                ti = o.GetTypeInfo()
            else:
                return "Error, cannot get ITypeInfo interface."

            typelib = ti.GetContainingTypeLib()[0]

            return (typelib.GetDocumentation(-1)[0] + ":\t\t" +  typelib.GetDocumentation(-1)[1] )

        except Exception as e:
            return  "Error: " + str(e) + "\n"

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


if __name__ == '__main__':
    RegisterThis()
    print("End of execution")

VBA Client Code

So the calling VBA code is shown below. It shows passing a Workbook object to the library finder which correctly reports it as belonging the Excel type library (that's obvious but it proves the logic is working). A second object is created which is far rarer (certainly I'd not heard of it) and the Python code correctly reports the library prefix, WIA, and the library description, 'Microsoft Windows Image Acquisition Library v2.0', which can then be found in the Tools References dialog box.

Option Explicit

Sub Test()
    On Error GoTo ErrHandler
    Dim oLibFinder As Object
    Set oLibFinder = CreateObject("PythonInVBA.WhichTypeLibrary")
    
    '* a simple example, find the containing type library of a Workbook, should print "Excel:      Microsoft Excel 15.0 Object Library"
    Debug.Print oLibFinder.ReportTypeLibrary(ThisWorkbook)
    
    '* a rarer example, should print "WIA:        Microsoft Windows Image Acquisition Library v2.0"
    Dim obj As Object
    Set obj = CreateObject("WIA.ImageFile")
    
    Debug.Print oLibFinder.ReportTypeLibrary(obj)
    
SingleExit:
    Exit Sub
ErrHandler:
    Debug.Print Err.Description
    Stop
    'Resume
    
End Sub

So the above program prints...

Excel:      Microsoft Excel 15.0 Object Library
WIA:        Microsoft Windows Image Acquisition Library v2.0

Factoid - ProgIDs have limit of 39 characters

What's Next, can the above Python class report on itself? No (or at least not yet).

If you are a little cheeky and wondered what would happen if you pass the library finder class itself to see what it said you would get an error.

Error: (-2147352567, 'Exception occurred.', None, None)

This is because the standard Python COM Gateway class carries no type information by default. It is capable of shipping type information is you associate it with a type library but then the type library needs to agree with the Python source. We can write some code to read a Python class and generate a type library and that will be the subject of the next post.

VBA - RecursiveExplorerWindows class - allows opening (and closing) of directory structures

So I wanted a class to open Windows Explorer windows on specific folders and then also the subfolders. Then I found some code I had written could not progress without those windows being closed. So I wrote some more code to close off all windows in a directory structure. Below is the code.

Much of this is standard. The UnExploreThisFolder method is quite interesting it uses the Microsoft Shell Controls and Automation type library to loop through windows to see if they need closing; the is a slight bug in their enumerator that does not like deletions midway through a loop so we handle that by starting a new enumeration.

The RecursiveExplorerWindows class

Option Explicit

'Class module RecursiveExplorerWindows

'*Tools->References
' *** Microsoft Scripting Runtime
' *** Microsoft Shell Controls and Automation

Private mfso As New Scripting.FileSystemObject

Public Sub OpenFolderAndAllSubfolder(ByVal sFolder As String)

    If mfso.FolderExists(sFolder) Then
    
        OpenFolderAndAllSubfolder2 mfso.GetFolder(sFolder)
    
    End If

End Sub

Private Sub OpenFolderAndAllSubfolder2(ByVal oFolder As Scripting.Folder)
    
    If Not oFolder Is Nothing Then
    
        ExploreThisFolder oFolder.Path
        
        Dim oFolderLoop As Scripting.Folder
        For Each oFolderLoop In oFolder.SubFolders
            
            OpenFolderAndAllSubfolder2 oFolderLoop
        
        Next

    End If

End Sub

Public Sub CloseFolderAndAllSubfolder(ByVal sFolder As String)

    If mfso.FolderExists(sFolder) Then
    
        CloseFolderAndAllSubfolder2 mfso.GetFolder(sFolder)
    
    End If

End Sub


Private Sub CloseFolderAndAllSubfolder2(ByVal oFolder As Scripting.Folder)
    
    If Not oFolder Is Nothing Then
    
        UnExploreThisFolder oFolder.Path
        
        Dim oFolderLoop As Scripting.Folder
        For Each oFolderLoop In oFolder.SubFolders
            
            CloseFolderAndAllSubfolder2 oFolderLoop
        
        Next

    End If

End Sub


Public Sub ExploreThisFolder(ByVal sFolder As String)
    Shell "explorer.exe " & sFolder, vbNormalFocus
End Sub

Public Sub UnExploreThisFolder(ByVal sFolder As String)


    Dim bFullFolder As Boolean
    bFullFolder = mfso.FolderExists(sFolder)

    Dim sComparableProperty As String
    sComparableProperty = VBA.IIf(bFullFolder, "LocationURL", "LocationName")
    
    Dim sCompareValue As String: sCompareValue = vbNullString
    If bFullFolder Then
        If Right$(sCompareValue, 1) = "\" Then
            sCompareValue = Left$(sCompareValue, Len(sCompareValue) - 1)
        End If
    
        sCompareValue = "file:///" & Replace(sFolder, "\", "/", 1)
    Else
        sCompareValue = sFolder
    End If


    Dim bNoMoreToClose As Boolean
    bNoMoreToClose = True

    Dim oShell As Shell32.Shell
    Set oShell = New Shell32.Shell
    
    Dim wins As Object 'Shell32.Windows
    Set wins = oShell.Windows
    
    '* the enumerator does not handle deletions midway thru loop very well
    '* if we delete one then we need to go again and reset the enumerator, *sigh*
    
    While bNoMoreToClose
        
        bNoMoreToClose = False
        DoEvents
    
        Dim winLoop As Variant
        For Each winLoop In oShell.Windows
            Dim sLoopCompareValue As String
            sLoopCompareValue = CallByName(winLoop, sComparableProperty, VbGet)
            
            If StrComp(sLoopCompareValue, sCompareValue) = 0 Then
            'If winLoop.LocationName = sCompareValue Then
                winLoop.Quit
                bNoMoreToClose = True
            End If
        Next
    Wend
End Sub

The tstTestRecursiveExplorerWindows standard (test) module

Option Explicit
Option Private Module

'standard module tstTestRecursiveExplorerWindows

'*Tools->References
' *** Microsoft Scripting Runtime

Private mfso As New Scripting.FileSystemObject

Private Sub TestExploreThisFolder()
    Dim oRecursiveExplorerWindows As RecursiveExplorerWindows
    Set oRecursiveExplorerWindows = New RecursiveExplorerWindows

    Dim s As String
    s = Environ$("userprofile") & "\AppData\Local\Temp\VBAEquivOfOpenXML\Book1\"
    
    Debug.Assert mfso.FolderExists(s)
    
    oRecursiveExplorerWindows.ExploreThisFolder s
End Sub

Private Sub TestUnexploreThisFolder_FullFolder()
    Dim oRecursiveExplorerWindows As RecursiveExplorerWindows
    Set oRecursiveExplorerWindows = New RecursiveExplorerWindows

    Dim s As String
    s = Environ$("userprofile") & "\AppData\Local\Temp\VBAEquivOfOpenXML\Book1\"
    
    Debug.Assert mfso.FolderExists(s)
    
    oRecursiveExplorerWindows.UnExploreThisFolder s
End Sub

Private Sub TestUnexploreThisFolder_LeafFolderName()
    Dim oRecursiveExplorerWindows As RecursiveExplorerWindows
    Set oRecursiveExplorerWindows = New RecursiveExplorerWindows

    
    oRecursiveExplorerWindows.UnExploreThisFolder "Downloads"
    oRecursiveExplorerWindows.UnExploreThisFolder "Book1"
End Sub

Private Sub TestOpenFolderAndAllSubfolder()
    Dim oRecursiveExplorerWindows As RecursiveExplorerWindows
    Set oRecursiveExplorerWindows = New RecursiveExplorerWindows

    Dim s As String
    s = Environ$("userprofile") & "\AppData\Local\Temp\VBAEquivOfOpenXML\Book1\"
    
    Debug.Assert mfso.FolderExists(s)
    
    oRecursiveExplorerWindows.OpenFolderAndAllSubfolder s
End Sub

Private Sub TestCloseFolderAndAllSubfolder()
    Dim oRecursiveExplorerWindows As RecursiveExplorerWindows
    Set oRecursiveExplorerWindows = New RecursiveExplorerWindows

    Dim s As String
    s = Environ$("userprofile") & "\AppData\Local\Temp\VBAEquivOfOpenXML\Book1\"
    
    Debug.Assert mfso.FolderExists(s)
    
    oRecursiveExplorerWindows.CloseFolderAndAllSubfolder s
End Sub