如何通过第一个Excel实例的宏刷新第二个实例中的数据？

要遍历所有独立运行的Excel实例，你需要借助Windows API枚举所有Excel窗口，再通过GetObject获取对应的Application对象。以下是完整的实现代码：

步骤1：添加Windows API声明 #

在VBA模块的顶部添加以下API声明（需放在所有过程之外）：

Option Explicit

' Windows API声明：枚举窗口、获取窗口类名、获取窗口所属进程ID
Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Boolean
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
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

' 用于获取Excel实例的GUID
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0

步骤2：编写收集所有Excel实例的函数 #

Private Function GetAllExcelInstances() As Collection
    Dim colInstances As New Collection
    Dim hwnd As LongPtr
    
    ' 枚举所有顶级窗口，回调函数处理每个窗口
    EnumWindows AddressOf EnumWindowsProc, VarPtr(colInstances)
    
    Set GetAllExcelInstances = colInstances
End Function

Private Function EnumWindowsProc(ByVal hwnd As LongPtr, ByVal lParam As LongPtr) As Boolean
    Dim className As String * 256
    Dim excelApp As Object
    Dim colInstances As Collection
    
    Set colInstances = GetCollectionFromPtr(lParam)
    
    ' 获取窗口类名，判断是否为Excel窗口
    GetClassName hwnd, className, 256
    If Left$(className, 7) = "XLMAIN" Then ' Excel主窗口类名是XLMAIN
        ' 通过AccessibleObjectFromWindow获取对应的Excel Application实例
        If AccessibleObjectFromWindow(hwnd, OBJID_NATIVEOM, GuidFromString(IID_IDispatch), excelApp) = 0 Then
            ' 避免重复添加同一个实例
            Dim existing As Object
            Dim isDuplicate As Boolean
            isDuplicate = False
            For Each existing In colInstances
                If existing Is excelApp Then
                    isDuplicate = True
                    Exit For
                End If
            Next
            If Not isDuplicate Then
                colInstances.Add excelApp
            End If
        End If
    End If
    
    EnumWindowsProc = True ' 继续枚举下一个窗口
End Function

Private Function GuidFromString(ByVal guid As String) As GUID
    Dim guidObj As GUID
    With guidObj
        .Data1 = Val("&H" & Mid$(guid, 2, 8))
        .Data2 = Val("&H" & Mid$(guid, 11, 4))
        .Data3 = Val("&H" & Mid$(guid, 16, 4))
        .Data4(0) = Val("&H" & Mid$(guid, 21, 2))
        .Data4(1) = Val("&H" & Mid$(guid, 23, 2))
        Dim i As Integer
        For i = 2 To 7
            .Data4(i) = Val("&H" & Mid$(guid, 25 + (i - 2) * 2, 2))
        Next i
    End With
    Set GuidFromString = guidObj
End Function

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

Private Function GetCollectionFromPtr(ByVal ptr As LongPtr) As Collection
    Dim col As Collection
    CopyMemory col, ptr, LenB(ptr)
    Set GetCollectionFromPtr = col
    CopyMemory col, 0&, LenB(ptr) ' 清空指针，避免内存泄漏
End Function

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal bytes As LongPtr)

步骤3：编写主刷新过程 #

替换你原来的代码，用以下过程实现跨实例刷新：

Sub RefreshAllWorkbooksAcrossInstances()
    Dim excelInstances As Collection
    Dim excelApp As Object
    Dim wb As Workbook
    Dim mainWBName As String
    
    mainWBName = "Main.xlsb" ' 你的主工作簿名称
    
    Set excelInstances = GetAllExcelInstances()
    
    ' 遍历每个Excel实例
    For Each excelApp In excelInstances
        On Error Resume Next ' 处理可能的权限或实例访问问题
        ' 遍历当前实例下的所有工作簿
        For Each wb In excelApp.Workbooks
            ' 跳过主工作簿
            If wb.Name <> mainWBName Then
                ' 刷新所有数据连接
                wb.RefreshAll
                ' 等待异步查询完成
                excelApp.CalculateUntilAsyncQueriesDone
                ' 等待计算完成
                Do Until excelApp.CalculationState = xlDone
                    DoEvents ' 释放CPU资源，避免假死
                Loop
            End If
        Next wb
        On Error GoTo 0
    Next excelApp
    
    MsgBox "所有工作簿已完成刷新！", vbInformation
End Sub

关键说明 #

• 代码通过枚举所有XLMAIN类的窗口（Excel主窗口），获取每个窗口对应的Excel Application实例，确保覆盖所有独立打开的Excel进程（包括SharePoint打开的实例）。
• 添加了DoEvents避免等待计算时Excel假死。
• 加入了重复实例判断，防止同一个实例被多次处理。
• 错误处理部分避免因权限问题导致整个过程中断。

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