使用第一个实例中的宏刷新第二个实例中的数据

问题描述 投票:0回答:1

我有一个 Excel 文件(实例 #1),其中包含用于刷新与该文件独立的任何打开的 Excel 文件的数据的代码。

问题是,打开的另一个 Excel 文件来自 SharePoint,因此它是 Excel 的第二个实例(实例 #2)。我当前的代码无法识别实例 #2。如果第二个文件不在单独的实例中,则刷新将起作用。

For Each wb In Application.Workbooks

'***** Skip the "Main" workbook. Proceed for any other open workbook *****
If wb.Name <> "Main.xlsb" Then
    '***** Refresh all data connections. *****
    wb.RefreshAll
    wb.Application.CalculateUntilAsyncQueriesDone
        '***** Loop until the workbook calculation status is "Done" *****
        Do Until wb.Application.CalculationState = xlDone
        Loop
End If

Next wb

我想我需要合并

GetObject(,"Excel.Application")
,但我不确定如何循环可能的实例。另外,文件的名称每次都会不同,因此我无法使用文件路径 - 我想使用“不是当前文件的 Excel 文件”。

excel vba sharepoint
1个回答
0
投票

我相信在蒂姆·威廉姆斯提供的链接以及上一篇文章的帮助下,我已经找到了适合我的解决方案。

我更新了我的程序,以调用一个使用

hwnd
查找所有打开的 Excel 实例并将它们存储在
Collection
中的函数。然后,我删除了一个我不想使用的集合项,这使得我的集合中只剩下 1 个实例。

从那里,我为集合中的实例/工作簿设置一个

Workbook
变量并执行刷新。

第 1 步 - 声明

#If VBA7 Then
  Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
    ByVal hwnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long

  Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
    ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, _
    ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
#Else
  Private Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
    ByVal hwnd As Long, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long

  Private Declare Function FindWindowExA Lib "user32" ( _
    ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
    ByVal lpszClass As String, ByVal lpszWindow As String) As Long
#End If

第 2 步 - 主子

Sub Refresh()
'***** Loop through all instances of Excel *****
  Dim xl As Excel.Application
  Dim i As Integer
  Dim wb As Workbook
  
  '***** Create a Collection of Excel Instances *****
  For Each xl In GetExcelInstances()
    '***** Print the details of the remaining Excel instance in the Collection *****
'    Debug.Print "Handle: " & xl.Application.hwnd
'    Debug.Print "# workbooks: " & xl.Application.Workbooks.Count
    For i = 1 To xl.Application.Workbooks.Count
'        Debug.Print "Workbook: " & xl.Application.Workbooks(i).Name
'        Debug.Print "Workbook path: " & xl.Application.Workbooks(i).Path
    Next i
    
    '***** Set workbook as the 1 remaining workbook from the collection *****
    Set wb = xl.Application.Workbooks(1)
    wb.RefreshAll
    wb.Application.CalculateUntilAsyncQueriesDone

  Next
  Set xl = Nothing
'    Do Until wb.Application.CalculationState = "xlDone"
'    Loop
'
End Sub

第 3 步 - 调用函数来创建集合

Private Function GetExcelInstances() As Collection
'***** Function to create collection of Excel instances based on hwnd *****
    Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
    guid(0) = &H20400
    guid(1) = &H0
    guid(2) = &HC0
    guid(3) = &H46000000
    Dim AlreadyThere As Boolean
    Dim xl As Application
    Set GetExcelInstances = New Collection
    Do
        hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
        If hwnd = 0 Then Exit Do
        hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
        hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
        If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
            AlreadyThere = False
            For Each xl In GetExcelInstances
                If xl Is acc.Application Then
                    '***** Do not add to the collection if it is already there *****
                    AlreadyThere = True
                    Exit For
                End If
            Next
            '***** If the window is not already in the collection then add it *****
            If Not AlreadyThere Then
                GetExcelInstances.Add acc.Application
            End If
        End If
    Loop
    '***** Remove the 1st item from the collection because it is the Bot Settings file (we don't want to work with this file) *****
    GetExcelInstances.Remove (1)
End Function
© www.soinside.com 2019 - 2024. All rights reserved.