Search code examples
vbams-worditerationinstancepid

How to iterate over multiple Word instances (with AccessibleObjectFromWindow)


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: Spy++ Output

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?


Solution

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

    enter image description here

    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:

    Key to translate below images:
    Próxima Janela => Next Window
    Janela Anterior => Previous Window
    Janela Pai => Parent Window
    Primeira Janela Filha => First Child Window
    Janela Proprietária => Previous Window
    

    For _WwF:

    enter image description here

    For its children _WwB:

    enter image description here

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

    enter image description here

    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.