如何通过Excel VBA获取多实例Word的所有文档（无需关闭实例）

要获取所有运行中的Word实例及其打开的文档，仅靠GetObject（只会返回第一个实例）无法实现，需要借助Windows API枚举所有Word窗口并关联到对应的Application对象。以下是无需关闭实例的解决方案：

完整VBA代码 #

Option Explicit

' Windows API声明（兼容32/64位Office）
Private 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

Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
    ByVal hWnd As LongPtr, ByVal dwId As Long, _
    ByRef riid As GUID, ppvObject As Object) As Long

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0

' 通过窗口句柄获取Word Application对象
Private Function GetWordAppFromHWND(hWnd As LongPtr) As Word.Application
    Dim objWordApp As Word.Application
    Dim iid As GUID
    
    ' 设置IAccessible接口的GUID（固定值）
    With iid
        .Data1 = &H618736E0
        .Data2 = &H3C3D
        .Data3 = &H11CF
        .Data4(0) = &H81
        .Data4(1) = &HC
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H38
        .Data4(6) = &H9B
        .Data4(7) = &H71
    End With
    
    ' 绑定到Word Application对象
    If AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, iid, objWordApp) = 0 Then
        Set GetWordAppFromHWND = objWordApp
    End If
End Function

' 枚举所有Word实例并列出文档
Sub ListAllWordDocuments()
    Dim hWnd As LongPtr
    Dim objWordApp As Word.Application
    Dim colWordApps As New Collection
    Dim doc As Word.Document
    Dim isDuplicate As Boolean
    Dim i As Integer
    
    ' 查找第一个Word主窗口（类名固定为OpusApp）
    hWnd = FindWindowEx(0&, 0&, "OpusApp", vbNullString)
    
    Do While hWnd <> 0
        Set objWordApp = GetWordAppFromHWND(hWnd)
        
        If Not objWordApp Is Nothing Then
            ' 检查该实例是否已处理过（避免同一实例多窗口重复枚举）
            isDuplicate = False
            For i = 1 To colWordApps.Count
                If colWordApps(i) Is objWordApp Then
                    isDuplicate = True
                    Exit For
                End If
            Next i
            
            If Not isDuplicate Then
                colWordApps.Add objWordApp
                
                ' 输出实例及文档信息（可改为MsgBox或写入Excel）
                Debug.Print "Word实例标题: " & objWordApp.Caption
                For Each doc In objWordApp.Documents
                    Debug.Print "  文档名称: " & doc.Name
                Next doc
            End If
        End If
        
        ' 查找下一个Word窗口
        hWnd = FindWindowEx(0&, hWnd, "OpusApp", vbNullString)
    Loop
    
    ' 释放对象
    Set objWordApp = Nothing
    Set colWordApps = Nothing
End Sub

代码说明 #

1. 核心逻辑：

   • 用FindWindowEx遍历系统中所有类名为OpusApp的窗口（Word主窗口的固定类名）。
   • 通过AccessibleObjectFromWindow将窗口句柄绑定到对应的Word Application实例。
   • 用Collection存储已处理的实例，避免同一实例多窗口重复输出。

2. 使用步骤：

   • 打开VBA编辑器（Alt+F11），在工具→引用中勾选Microsoft Word xx.x Object Library。
   • 运行ListAllWordDocuments，结果会输出到立即窗口（按Ctrl+G查看）。

3. 扩展建议：

   • 可将输出改为写入Excel单元格或弹出消息框，替换Debug.Print部分即可。

内容的提问来源于stack exchange，提问作者Vedvrat