3
\$\begingroup\$

A project of mine required me to search for certain workbooks in open instances of Excel. I found this article Code to get Excel, Word, PowerPoint from window handle which returns the applications for all the open Excel windows. Close to what I want but not exactly what I needed. The problem with that approach was that it could multiple references to the same instance. One reference per window. So after some research, blood sweet, and system crashes; this is what I came up with.

Option Explicit

Rem VBA - Code to get Excel, Word, PowerPoint from window handle
Rem http://exceldevelopmentplatform.blogspot.com/2019/01/vba-code-to-get-excel-word-powerpoint.html
#If VBA7 Then
Public Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As LongPtr, ByVal dwId As LongPtr, ByRef riid As Any, ByRef ppvObject As Object) As LongPtr
Public Declare PtrSafe Function FindWindowEx Lib "USER32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal Hwnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Public Declare PtrSafe Function GetWindowThreadProcessId Lib "USER32" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long
#Else
Public Declare Function AccessibleObjectFromWindow Lib "oleacc"(ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As Any, ByRef ppvObject As Object) As Long
Public Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" Alias "GetWindowThreadProcessId" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
#End If


Function ProcIDFromHWnd(ByVal hwnd As Variant) As Variant
    Dim idProc As Variant
    GetWindowThreadProcessId hwnd, idProc
    ProcIDFromHWnd = idProc
End Function

Public Function InstanceMap(ParamArray ClassList() As Variant) As Collection
    Dim GUID&(0 To 3)
    GUID(0) = &H20400
    GUID(1) = &H0
    GUID(2) = &HC0
    GUID(3) = &H46000000
    
    #If VBA7 Then
    Dim hwnd As LongPtr, ChildHwnd As LongPtr, PID As LongPtr
    #Else
    Dim hwnd As Long, ChildHwnd As Long, PID As Long
    #End If
    
    Dim WindowObject As Object
    Dim Map As New Collection
    Dim n As Long
    Do
        hwnd = FindWindowEx(0, hwnd, CStr(ClassList(0)), vbNullString)
        If hwnd = 0 Then Exit Do
    
        ChildHwnd = hwnd
        For n = 1 To UBound(ClassList)
            ChildHwnd = FindWindowEx(ChildHwnd, 0, CStr(ClassList(n)), vbNullString)
        Next
    
        If AccessibleObjectFromWindow(ChildHwnd, &HFFFFFFF0, GUID(0), WindowObject) = 0 Then
            On Error Resume Next
            PID = ProcIDFromHWnd(hwnd)
            Map.Add WindowObject.Application, CStr(PID)
            On Error GoTo 0
        End If
        DoEvents
    Loop
    Set InstanceMap = Map
End Function

Public Function ExcelInstanceMap() As Collection
    Set ExcelInstanceMap = InstanceMap("XLMAIN", "XLDESK", "EXCEL7")
End Function

Public Function WordInstanceMap() As Collection
    Set WordInstanceMap = InstanceMap("OpusApp", "_WwF", "_WwB", "_WwG")
End Function

Public Function PowerPointInstanceMap() As Collection
    Set PowerPointInstanceMap = InstanceMap("PPTFrameClass", "MDIClient", "mdiClass")
End Function

The code runs fine but while refactoring it a came across something peculiar in the following line:

If AccessibleObjectFromWindow(ChildHwnd, &HFFFFFFF0, GUID(0), WindowObject) = 0 Then

GUID is a 4 element array of long values. No where in the code is the full array used, only the first element (&H20400). So I thought that I could get rid of the array altogether and just pass in &H20400. Wrong!

My guess is that either the dll file's garbage collector is expecting to clean up all the values or the while array is getting referenced when GUID(0) is passed into the function or more than likely something different.

\$\endgroup\$
5
  • 2
    \$\begingroup\$ "No where in the code is the full array used, only the first element" actually since you pass the first element ByRef riid As Any what you're actually supplying is a pointer to the first element of the GUID array rather than the value of the first element. The API function can offset this pointer to find other parts of the array, or more likely will just dereference the 128bits of the GUID at once starting from the pointer. This works because values from VBA SAFEARRAYs are stored adjacent in memory. Change to ByVal pRiid As LongPtr and VarPtr(GUID(0)) and it will make more sense. \$\endgroup\$
    – Greedo
    Sep 29 at 12:22
  • \$\begingroup\$ Basically what I originally thought but well stated. Thanks @Greedo \$\endgroup\$
    – TinMan
    Sep 29 at 14:51
  • \$\begingroup\$ @Greedo Ah- that's why it's passing in the first value. \$\endgroup\$
    – TinMan
    Sep 29 at 14:53
  • 1
    \$\begingroup\$ Have you tried using GetObject(, "Excel.Application") ? If you think there are multiple instances I would go through them, closing them as I go until the GetObject fails. Would be much simpler with native methods like this. Related reading: docs.microsoft.com/en-us/office/troubleshoot/… \$\endgroup\$
    – HackSlash
    Sep 29 at 16:15
  • 1
    \$\begingroup\$ Thanks @HackSlash But my code works as intended. Some uses cases require me to work with multiple instances. In this case, when the user double clicks a third party embedded chart object. The comAddIn then opens a workbook in anew instance of Excel populated with all the chart data. My program detects the new worksheet gathers the data, closed the instance and the user does a wash, rinse and repeat. \$\endgroup\$
    – TinMan
    Sep 29 at 17:10
5
\$\begingroup\$
Public Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As LongPtr, ByVal dwId As LongPtr, ByRef riid As Any, ByRef ppvObject As Object) As LongPtr
Public Declare PtrSafe Function FindWindowEx Lib "USER32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal Hwnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Public Declare PtrSafe Function GetWindowThreadProcessId Lib "USER32" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long

I feel quite strongly that API declares are rarely used to their full potential in VBA. People too often transliterate these declarations - rewriting C++ code in VBA, rather than translating them into idiomatic VBA. The Alias keyword and ByRef/ByVal modifiers can be used to achieve a higher standard of abstraction similar to what you would expect from other VBA code you write, and renaming variables to avoid Systems Hungarian notation which is not required in VBA can simplify the black box of WinApi calls as well. For example why do I need to know lpszFoo is a long pointer to a zero terminated string when VBA literally defines native strings in that way? The code calling the API does not need to be aware of this low level information, get rid of it. I sometimes even declare the same function twice under different aliases to match the context in which it is called.

So I would modify the declares to something like this:

'Stolen from https://github.com/wine-mirror/wine/blob/08b01d8271fe15c7680a957778d506221d7d94eb/include/winuser.h#L3181-L3195
Private Enum ObjectIdentifier
    OBJID_WINDOW = 0
    OBJID_SYSMENU = -1
    OBJID_TITLEBAR = -2
    OBJID_MENU = -3
    OBJID_CLIENT = -4
    OBJID_VSCROLL = -5
    OBJID_HSCROLL = -6
    OBJID_SIZEGRIP = -7
    OBJID_CARET = -8
    OBJID_CURSOR = -9
    OBJID_ALERT = -10
    OBJID_SOUND = -11
    OBJID_QUERYCLASSNAMEIDX = -12
    OBJID_NATIVEOM = -16     'This is the one you use,  &HFFFFFFF0
End Enum

Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As LongPtr, ByVal ID As ObjectIdentifier, ByRef interfaceRiid As Any, ByRef outInstance As Object) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "USER32" Alias "FindWindowExA" (ByVal hWndParent As LongPtr, ByVal hWndChildAfter As LongPtr, ByVal className As String, Optional ByVal windowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "USER32" (ByVal hwnd As LongPtr, ByRef outProcessId As Long) As Long
  • Everything Private because these are implementation details and don't need to be exposed.
  • Introduce an ObjectIdentifier Enum to get rid of magic &HFFFFFFF0 later on.
  • In AccessibleObjectFromWindow, change ByVal dwId As LongPtr to ByVal ID As ObjectIdentifier since dw stands for DWORD which is a 32-bit integer always, just like VBA's Long (Enum is an alias for Long, so they can be used interchangeably).
  • Explicit ByRef keyword added to the lpdwProcessID because it's important it doesn't become ByVal.
  • In fact if we say ByRef we can drop the lp prefix since that's what ByRef means, and we can also drop dw since that's what As Long means.
  • Use outBlah for variables which will be assigned by the API functions.
  • It's fine to use Optional in these functions too if you always pass vbNullString

I know you probably just copy-pasted from vb forums so moving on...


Function ProcIDFromHWnd(ByVal hwnd As Variant) As Variant
    Dim idProc As Variant
    GetWindowThreadProcessId hwnd, idProc
    ProcIDFromHWnd = idProc
End Function

Instead, how about without variant:

Private Function ProcIDFromHWnd(ByVal hwnd As LongPtr) As Long
    If GetWindowThreadProcessId(hwnd, outProcessId:=ProcIDFromHWnd) = 0 Then
        Err.Raise 5, Description:="We didn't get a valid thread ID"
    End If
End Function

Notice you can also use the return value to see if the function succeeded.


Dim hwnd As LongPtr, ChildHwnd As LongPtr, PID As LongPtr

I guess declare these closer to usage would be nice, although I see you use conditional compilation so it could get messy. Should be PID As Long though, again DWORDs are always 32-bit.*

*Oversized variables still generally happen to work - because VBA is managing the memory so it gets allocated/ deallocated properly still, and integral types are little endian (or fill memory in reverse) meaning the first 32 bits of a Long or a LongLong with the same value will be the same.


On Error Resume Next
PID = ProcIDFromHWnd(hwnd)
Map.Add WindowObject.Application, CStr(PID)
On Error GoTo 0

What error are you expecting? Better to remove so you can launch into the debugger when an error occurs.


Do
    hwnd = FindWindowEx(0, hwnd, CStr(ClassList(0)), vbNullString)
    If hwnd = 0 Then Exit Do

    ChildHwnd = hwnd
    For n = 1 To UBound(ClassList)
        ChildHwnd = FindWindowEx(ChildHwnd, 0, CStr(ClassList(n)), vbNullString)
    Next
    '[...]
    DoEvents
Loop

This is kinda dangerous having an infinite loop with DoEvents. What if that allows the Z-Order of windows to change, meaning hwnd = FindWindowEx(0, hwnd, CStr(ClassList(0)), vbNullString) will never return 0 since you keep hopping between windows. Removing the DoEvents would be good although the situation could still crop up where you have a circular reference because another application is misbehaving. Safer would be to keep a track of all hwnds you've seen and then exit the loop if one repeats.

Also the process of looping through top level windows with FindWindowEx(0, 0 |prevhwnd, specialClassName,"") has a few too many re-assignments and could be cleaned up.

I would add maybe:

Private Function TryGetNextWindowHwnd(ByVal className As String, ByVal prevHWnd As LongPtr, ByRef outNextHWnd As LongPtr) As Boolean
    outNextHWnd = FindWindowEx(0, prevHWnd, className)
    TryGetNextWindowHwnd = outNextHWnd <> 0
End Function

... which you can use in the loop:

Do While TryGetNextWindowHwnd(TopLevelClassName, parentHWnd, outNextHWnd:=parentHWnd)

For n = 1 To UBound(ClassList)
    ChildHwnd = FindWindowEx(ChildHwnd, 0, CStr(ClassList(n)), vbNullString)
Next

Maybe add a comment saying what this does, drilling down through window class names took me by surprise a little. Also CStr is redundant, and since ClassList(n) only goes from 1 to ubound, maybe ClassList(0) should be passed as its own argument:

Public Function InstanceMap(ByVal TopLevelClassName As String, ParamArray ClassList() As Variant) As Collection

Public Function ExcelInstanceMap() As Collection
    Set ExcelInstanceMap = InstanceMap("XLMAIN", "XLDESK", "EXCEL7")
End Function

Public Function WordInstanceMap() As Collection
    Set WordInstanceMap = InstanceMap("OpusApp", "_WwF", "_WwB", "_WwG")
End Function

Public Function PowerPointInstanceMap() As Collection
    Set PowerPointInstanceMap = InstanceMap("PPTFrameClass", "MDIClient", "mdiClass")
End Function

Really nice simple interface. A shame it isn't strongly typed as Excel.Application, Word.Application though. Still the iteration variable could be. Also why store PID as the key in a collection at all; since collection keys are not readable, the only reason I can think to use it would be to lookup the instance of the current process' Application from the collection - but in that case you could just use the default Application object.

\$\endgroup\$
3
  • 1
    \$\begingroup\$ "I feel quite strongly that API declares are rarely used to their full potential in VBA. People too often transliterate these declarations - rewriting C++ code in VBA, rather than translating them into idiomatic VBA". Would give you +1 just for that. Lots of gems in rest as well. \$\endgroup\$ Sep 30 at 21:49
  • \$\begingroup\$ Great Review!!! I use the Windows API Viewer for Excel x64. Agreed, the first class should be a named argument. I did not know that changing the Z-Order have that effect, awesome tip! DoEvents was added as a precaution. The user clicks a toggle which monitors for new applications being opened in a loop. I'll have to think about this \$\endgroup\$
    – TinMan
    Sep 30 at 21:58
  • 1
    \$\begingroup\$ AccessibleObjectFromWindow returns a handle for each Excel window. An application may have more that 1 window. The PID is used to filter out the duplicates. This would have probably made a good comment in the script. \$\endgroup\$
    – TinMan
    Sep 30 at 22:04

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.