vba - 如何迭代多个 Word 实例(使用 AccessibleObjectFromWindow)

Question

我需要遍历所有 Word 实例，无论是由用户、自动化、zumbis 等打开的。

我将描述到目前为止的所有步骤:
我看到并实现了我得到的解决方案 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

它有效，但是:

为了迭代所有单词实例，我们必须 GetObject 并关闭它，循环直到没有更多打开的实例，然后重新打开我关心的所有内容

这需要大量时间和 R/W 周期和磁盘访问

而且当然要在Word之外完成，因为它可能会先关闭代码运行实例，或者在循环中间...

所以，经过一番谷歌搜索，我看到了一些直接访问进程的例子， here和 here对于 VB。

我设法获得了所有 Winword.exe 实例的 PID，主要是对 VBForums 处的代码进行了一些修改。 :

仅显示修改后的代码段:

   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)

对于上面的代码运行，我们需要包含进程名称 (szExeFile) 和进程 ID 字段 (th32ProcessID) 的 PROCESSENTRY32 结构；此代码是@ VBnet/Randy Birch .

所以，现在我有了“实例 PID”这个词；接下来是什么？

这样做之后，我尝试查看如何将这些 PID 实例传递给 GetObject 函数。

这时候就碰到了这个Python thread ，这让我大开眼界 AccessibleObjectFromWindow从 Windows 句柄创建一个对象。

我挖了很多地方，最有用的是这些 here , here和 here并且可以得到这段代码:

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

错误在上面的代码中被注释(########)；但恢复后，我识别了所有实例，但无法检索该对象。
对于 Excel，这些行:

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

有效，因为我得到了 hWinDesk = 1511272 和 332558 而不是零，并且在我得到 Excel 对象之后。

EXCEL7对应的Word Windows类是_WwG(但上面给出了0)，XLMAIN对应的Word类名是OpusApp。 Word对应的XLDESK是什么？

所以，我需要帮助来发现它；或者你知道如何在知道它是PID的VBA中捕获COM对象吗？
MS本身建议我查一下 Office 200 docs ;我会这样做，但如果有人以前这样做过......

事实上，现在我对这两种方法都感兴趣，但当然最后一种已实现 99%，所以，我更喜欢。

TIA

附言当然，在实现时，所有对象都将关闭/无，错误处理等......

编辑 1:
根据@Comintern 的建议，这是 Spy++ 输出:


有趣的是，我在Excel输出中只能定位到两个字符串:XLMAIN和XLDESK，却完全找不到EXCEL7，并且成功捕获了Excel对象。对于 Word，我测试了所有字符串 (_WwC,_WwO,)，但仅

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

有一个 Handlebars ，按这个顺序；但无济于事，因为

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

有任何想法吗？方向？

Answer 1

在按照@Comintern 的建议与 Spy++ 更加亲密之后，我追踪了这个:



这是实际的窗口顺序； OpusApp 下的所有窗口都是它的子窗口

但是要了解它为什么现在起作用，我们必须右键单击下面的每个 _Ww[A_Z]:

对于_WwF:



对于它的 child _WwB:



终于达到目标了!!!!! _工作组:



使用这种方法，很明显我们必须在代码中添加另一层:

  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

我不明白但现在不介意的是为什么对 2 个不同的实例重复结果:
Debug.print 结果:

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

但是为了解决这个问题，我将调整 marvel solution来自@PGS62；继续:

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

而且，瞧，为大众迭代所有 Word 实例，而无需关闭和重新打开!!!

感谢社区，感谢其他线程中的所有想法，感谢@Comintern 提供重要建议。