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并将其关闭，循环直到不再有打开的实例，然后重新打开所有我关心的
- 这需要花费很多时间和读写周期以及磁盘访问权限
- 当然必须在Word外部完成，因为它可能首先关闭正在运行的实例的代码，或者在循环的中间...

因此，在进行了一些谷歌搜索之后，我看到了一些直接访问过程的示例，分别是VB的here和here。

我设法获取了所有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)

对于上面的代码运行，我们需要PROCESSENTRY32结构，该结构同时包含进程名称（szExeFile）和进程ID字段（th32ProcessID）；此代码为@ VBnet/Randy Birch。

所以，现在我有instance instance PIDs这个词；接下来是什么？

这样做之后，我试图查看如何将这些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

P.S。当然，实施后，所有对象都将关闭/关闭，进行错误处理等。

编辑1： 这是Spy ++的输出，按照@Comintern建议：

有趣的是，我只能在Excel输出中找到以下两个字符串：XLMAIN和XLDESK，但根本找不到EXCEL7，并且成功捕获了Excel对象。对于Word，我测试了所有字符串（_WwC，_WwO，），但只有

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

按顺序获得一个句柄；但无济于事，因为

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

有什么想法吗？方向？

Answer 1

我可以验证您的代码。

这是Word的Windows句柄上的图，该句柄响应Accessibility接口查询（黄色，注释中显示TypeName），并且可以将其强制转换为Word.Application（浅绿色）

Original article is here (Disclaimer that's my blog)

您的问题使我无法找到一个通用的案例，因此在那篇博文中可以找到也可以到达PowerPoint实例（当然还有Excel）的代码。感谢您的挑战。

Answer 2

按照@Comintern的建议与Spy ++更加亲密之后，我对此进行了追踪：

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

但是要了解为什么它现在可以运行，我们必须右键单击下面的每个_Ww [A_Z]：

对于_WwF：

对于其子_WwB：

最后达到目标！！！！ _WwG：

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

  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

我不明白，但现在不介意的是，为什么在两个不同的实例上重复结果： Debug.print结果：

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

但是要解决这个问题，我将改用@ PGS62的marvel solution；恢复：

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提供重要建议。

如何遍历多个Word实例（使用AccessibleObjectFromWindow）

2 个答案: