vba - How to iterate over multiple Word instances (with AccessibleObjectFromWindow)

Question

I need to iterate over all Word instances, no matter if opened by users, by automation, zumbis, etc.

I will describe all the steps until now: I saw and implemented the solutions that I got here;

       Do
            For Each objWordDocument In objWordApplication.Documents
               OpenDocs(iContadorDocs - 1) = objWordDocument.Name
               OpenDocs(iContadorDocs) = objWordDocument.path
               iContadorDocs = iContadorDocs + 2
               ReDim Preserve OpenDocs(iContadorDocs)
            Next objWordDocument
            iWordInstances = iWordInstances + 1
            objWordApplication.Quit False
            Set objWordApplication = Nothing
            Set objWordApplication = GetObject(, "Word.Application")
       Loop While Not objWordApplication Is Nothing

it works, but:

1. for iterate over all word instances we have to GetObject and close it, looping until no more opened instances are, and after, reopen all that I care

   • this take a lot of time & R/W cycles & Disk Access

   • and of course has to be accomplished outside Word, because it may close the code running instance first, or in the middle of the loop...

So, after some googling, I saw some examples of access the process direct, here and here for VB.

I managed to get the PID for all Winword.exe instances, mainly adapting a little the code at VBForums:

Showing only the modified piece of code:

   Do
        If LCase(VBA.Left$(uProcess.szExeFile, InStr(1, uProcess.szExeFile, Chr(0)) - 1)) = LCase(ProcessName) Then
            ProcessId = uProcess.th32ProcessID
            Debug.Print "Process name: " & ProcessName & "; Process ID: " & ProcessId
        End If
   Loop While ProcessNext(hSnapShot, uProcess)

For the above code run, we need the PROCESSENTRY32 structure that include both process name (szExeFile) and Process Id fields (th32ProcessID); this code is @ VBnet/Randy Birch.

So, now I have the word instances PIDs; what next?

After doing that, I tried to see how could I pass these PID instances to the GetObject function.

At this time I bumped into this Python thread, that opened my eyes to the AccessibleObjectFromWindow that creates an object from a windows handle.

I dug in a lot of places, the most useful being these here, here and here and could get this piece of code:

Private 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
Private Declare Function IIDFromString Lib "ole32" _
        (ByVal lpsz As Long, ByRef lpiid As GUID) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
        (ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As GUID, _
         ByRef ppvObject As Object) As Long

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
Private Const S_OK As Long = &H0
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0

Sub testWord()
Dim i As Long
Dim hWinWord As Long
Dim wordApp As Object
Dim doc As Object
    'Below line is finding all my Word instances
    hWinWord = FindWindowEx(0&, 0&, "OpusApp", vbNullString)
    While hWinWord > 0
        i = i + 1
        '########Successful output
        Debug.Print "Instance_" & i; hWinWord
        '########Instance_1 2034768 
        '########Instance_2 3086118 
        '########Instance_3 595594 
        '########Instance_4 465560 
        '########Below is the problem
        If GetWordapp(hWinWord, wordApp) Then
            For Each doc In wordApp.documents
                Debug.Print , doc.Name
            Next
        End If
        hWinWord = FindWindowEx(0, hWinWord, "OpusApp", vbNullString)
    Wend
End Sub

Function GetWordapp(hWinWord As Long, wordApp As Object) As Boolean
Dim hWinDesk As Long, hWin7 As Long
Dim obj As Object
Dim iid As GUID

    Call IIDFromString(StrPtr(IID_IDispatch), iid)
    hWinDesk = FindWindowEx(hWinWord, 0&, "_WwF", vbNullString)
   '########Return 0 for majority of classes; only for _WwF it returns other than 0
    hWin7 = FindWindowEx(hWinDesk, 0&, "_WwB", vbNullString)
   '########Return 0 for majority of classes; only for _WwB it returns other than 0
    If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iid, obj) = S_OK Then
   '########Return -2147467259 and does not get object...
        Set wordApp = obj.Application
        GetWordapp = True
    End If
End Function

The errors are commented (########) above into the code; but resuming, I identify all instances, but cannot retrieve the object. For Excel, the lines:

hWinDesk = FindWindowEx(hWinXL, 0&, "XLDESK", vbNullString)
hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)

works, because instead of zero I got hWinDesk = 1511272 and 332558, and after I got the Excel object.

The EXCEL7 corresponding Word Windows class is _WwG (but it gives 0 above), the XLMAIN corresponding Word class name is OpusApp. What is the XLDESK corresponding for Word?

So, I need help to discover it; or do you know how to capture the COM object in VBA knowing it's PID? MS itself suggested that I look into the Office 200 docs; I'll do that, but if someone has did this before...

In fact now I'm interested in both approaches, but of course this last one is 99% implemented, so, my preferred.

TIA

P.S. Of course, when implemented, all objects will be closed/nothing, error-handling, etc...

EDIT 1: Here is Spy++ output, as per @Comintern advise:

Interesting is that I can locate in Excel output only two of the strings: XLMAIN and XLDESK, but cannot find at all the EXCEL7, and Excel object is successfully captured. For Word, I tested all the strings (_WwC,_WwO,), but only

?FindWindowEx(hWinWord, 0&, "_WwF", vbNullString)
 1185896 
?FindWindowEx(hWinDesk, 0&, "_WwB", vbNullString)
 5707422 

got a handle, in that order; but to no avail, because

 ?AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iid, obj)
-2147467259 

Any ideas? directions?

Answer 1

After getting more intimate with Spy++ as @Comintern suggested, I traced this:

This is the actual Window order; all windows below the OpusApp are its children

But to understand why it is functioning now, we have to right click every _Ww[A_Z] below:

For _WwF:

For its children _WwB:

And finally to the goal!!!!! _WwG:

With this approach, it is obvious that we must add another layer to the code:

  Function GetWordapp(hWinWord As Long, wordApp As Object) As Boolean
        Dim hWinDesk As Long, hWin7 As Long, hFinalWindow As Long
        Dim obj As Object
        Dim iid As GUID

        Call IIDFromString(StrPtr(IID_IDispatch), iid)
        hWinDesk = FindWindowEx(hWinWord, 0&, "_WwF", vbNullString)
        hWin7 = FindWindowEx(hWinDesk, 0&, "_WwB", vbNullString)
        hFinalWindow = FindWindowEx(hWin7, 0&, "_WwG", vbNullString)
        If AccessibleObjectFromWindow(hFinalWindow, OBJID_NATIVEOM, iid, obj) = S_OK Then
            Set wordApp = obj.Application
            GetWordapp = True
        End If
    End Function

What I don't understand, but don't mind now, is why duplicate results for 2 different instances: Debug.print results:

   Instance_1 1972934 
                  x - fatores reumaticos.docx
                  FormGerenciadorCentralPacientes.docm
    Instance_2 11010524 
                  x - fatores reumaticos.docx
                  FormGerenciadorCentralPacientes.docm
    Instance_3 4857668 

But to solve that, I'll adapt the marvel solution by @PGS62; resuming:

Private Function GetWordInstances() As Collection
    Dim AlreadyThere As Boolean
    Dim wd As Application
    Set GetWordInstances = New Collection
    ...code...
    For Each wd In GetWordInstances 
                If wd Is WordApp.Application Then
                    AlreadyThere = True
                    Exit For
                End If
            Next
            If Not AlreadyThere Then
                GetWordInstances.Add WordApp.Application
            End If
      ...code...
End Function

And, voilá, iteration for all Word instances for the masses without have to close and reopen!!!

Thanks, community, for all ideas in other threads, and @Comintern for the crucial advise.