Excel VBA如何遍历所有打开的Word文档（覆盖多Word应用进程场景）

GetObject(, "Word.Application") 只能获取系统中第一个注册的Word进程实例，无法覆盖多进程场景。需要通过枚举系统运行对象表(ROT) 来获取所有运行中的Word.Application实例，再遍历每个实例下的所有文档，具体实现步骤如下：

第一步：添加API声明 #

在VBA工程的标准模块最顶部添加如下兼容32/64位Office的API声明：

#If VBA7 Then
    Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As LongPtr, lpdwProcessId As Long) As Long
    Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPtr
    Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
#Else
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
    Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
#End If
Private Const PROCESS_ALL_ACCESS = &H1F0FFF

第二步：编写枚举所有Word实例的函数 #

在同一标准模块中添加如下功能函数，用于收集所有运行中的Word进程实例：

' 存储所有Word实例的全局集合
Dim wdApps As Collection

Function GetAllWordInstances() As Collection
    Set wdApps = New Collection
    EnumWindows AddressOf EnumWindowsProc, 0
    Set GetAllWordInstances = wdApps
End Function

#If VBA7 Then
Function EnumWindowsProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long
#Else
Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
#End If
    Dim sClassName As String * 256, lRet As Long, pid As Long
    Dim wdApp As Object, exists As Boolean, i As Long
    
    lRet = GetClassName(hWnd, sClassName, 256)
    ' Word主窗口的类名为OpusApp
    If Left(sClassName, lRet) = "OpusApp" Then
        GetWindowThreadProcessId hWnd, pid
        On Error Resume Next
        Set wdApp = GetObject(, "Word.Application." & pid)
        If Err.Number = 0 Then
            ' 去重，避免同一进程被重复添加
            exists = False
            For i = 1 To wdApps.Count
                If ObjPtr(wdApps(i)) = ObjPtr(wdApp) Then
                    exists = True
                    Exit For
                End If
            Next
            If Not exists Then wdApps.Add wdApp
        End If
        Err.Clear
        On Error GoTo 0
    End If
    EnumWindowsProc = 1 ' 继续枚举剩余窗口
End Function

第三步：替换原有列表框填充代码 #

将你原来的UserForm初始化填充列表框的代码替换为如下版本，即可遍历所有Word进程下的文档：

Dim allWdApps As Collection, wdApp As Object, mObj As Object
Set allWdApps = GetAllWordInstances()

If allWdApps.Count = 0 Then
    MsgBox "没有检测到打开的Word文档。若确认已打开文档，可尝试保存后重启Word再重试。"
    Call cClear
    Exit Sub
End If

' 遍历所有Word进程，再遍历每个进程下的所有文档
For Each wdApp In allWdApps
    For Each mObj In wdApp.Documents
        If Len(mObj.Name) > 37 Then
            UserForm1.ListBox1.AddItem Left(mObj.Name, 37) & "..."
        Else
            UserForm1.ListBox1.AddItem mObj.Name
        End If
        ' 可选拓展：将文档对象指针存储到列表框ItemData，方便后续直接操作选中的文档
        ' UserForm1.ListBox1.ItemData(UserForm1.ListBox1.ListCount - 1) = ObjPtr(mObj)
    Next mObj
    Set wdApp = Nothing
Next
Set allWdApps = Nothing

注意事项 #

• 兼容Office 2016及以上版本的32/64位运行环境
• 代码自动去重，不会出现同一份文档重复显示的问题
• 若后续需要操作选中的文档，可通过文档完整路径做唯一匹配，避免同名文档混淆

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