如何修改Word VBA代码跨Excel实例检测指定已打开工作簿？

原代码的问题在于未枚举系统中所有运行的Excel实例，而是直接创建新实例尝试打开文件，当目标工作簿已在另一个Excel实例中打开时，就会触发文件锁定错误。以下是修改后的代码，通过Windows API枚举所有Excel实例，实现跨实例检测目标工作簿：

' 声明Windows API函数用于枚举窗口
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 GetWindowThreadProcessId Lib "user32" _
    (ByVal hWnd As LongPtr, lpdwProcessId As Long) As Long
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" _
    (ByVal hWnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long

Sub EditExcelWorkbook()
    Dim targetFilePath As String
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim foundWB As Boolean
    
    targetFilePath = "C:\YourPath\Test.xlsx" ' 替换为你的目标文件路径
    
    ' 先尝试在已运行的Excel实例中查找工作簿
    Set xlApp = GetRunningExcelInstanceWithWorkbook(targetFilePath)
    
    If xlApp Is Nothing Then
        ' 未找到，新建Excel实例并打开工作簿
        Set xlApp = New Excel.Application
        xlApp.Visible = True ' 根据需要设置是否可见
        Set xlWB = xlApp.Workbooks.Open(targetFilePath)
        foundWB = True
    Else
        ' 找到已打开的工作簿
        Set xlWB = xlApp.Workbooks(GetWorkbookNameFromPath(targetFilePath))
        foundWB = True
    End If
    
    If foundWB Then
        ' 在这里添加你的编辑逻辑，比如修改单元格
        xlWB.Sheets(1).Range("A1").Value = "Updated from Word VBA"
        xlWB.Save ' 根据需要保存
        
        ' 若不需要保留Excel实例，可选择关闭（根据业务需求调整）
        ' xlWB.Close SaveChanges:=True
        ' xlApp.Quit
    End If
    
    ' 释放对象
    Set xlWB = Nothing
    Set xlApp = Nothing
End Sub

' 枚举所有Excel实例，查找包含目标工作簿的实例
Function GetRunningExcelInstanceWithWorkbook(filePath As String) As Excel.Application
    Dim hWnd As LongPtr
    Dim xlApp As Excel.Application
    Dim processId As Long
    Dim obj As Object
    Dim iid As GUID
    
    ' 定义IID_IDispatch
    With iid
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With
    
    hWnd = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
    Do While hWnd <> 0
        GetWindowThreadProcessId hWnd, processId
        If AccessibleObjectFromWindow(hWnd, &HFFFFFFF0, iid, obj) = 0 Then
            Set xlApp = obj.Application
            ' 遍历当前实例中的所有工作簿
            Dim wb As Excel.Workbook
            For Each wb In xlApp.Workbooks
                If StrComp(wb.FullName, filePath, vbTextCompare) = 0 Then
                    Set GetRunningExcelInstanceWithWorkbook = xlApp
                    Exit Function
                End If
            Next wb
        End If
        hWnd = FindWindowEx(0&, hWnd, "XLMAIN", vbNullString)
    Loop
    
    Set GetRunningExcelInstanceWithWorkbook = Nothing
End Function

' 从文件路径中提取工作簿名称
Function GetWorkbookNameFromPath(filePath As String) As String
    GetWorkbookNameFromPath = Mid(filePath, InStrRev(filePath, "\") + 1)
End Function

' 定义GUID结构
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

关键说明： #

• Windows API部分：通过FindWindowEx查找所有Excel主窗口（类名为XLMAIN），再通过AccessibleObjectFromWindow获取对应窗口的Excel应用实例。
• 跨实例检测：遍历每个Excel实例中的工作簿，对比文件完整路径，找到匹配的工作簿后返回对应的Excel应用对象。
• 兼容性：代码使用PtrSafe声明，支持32位和64位Office版本。

使用时注意：

1. 替换targetFilePath为你的实际文件路径。
2. 确保Word VBA编辑器中已引用Microsoft Excel xx.x Object Library（通过工具→引用勾选）。
3. 若目标工作簿处于只读锁定状态（比如其他用户正在编辑），仍需额外处理这种场景，可在打开时添加ReadOnly:=True参数。

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