升级到 Microsoft 365 后，宏/VBA 代码停止工作

Question

首先，我对 VBA 非常业余，并且从离开公司的人那里继承了一个文件。

他们设置了一个代码/宏，可以从 SAP 中提取报告，然后将其用于比较以前的数据并更新列表。这是库存地点的材料库存。

宏可以毫无问题地提取报告。它在生成时保存报告，但在接下来的时刻挂起。

'wait until export workbook is loaded so the first sheet can be re-named  
Do Until ActiveWorkbook.Name = "EXPORT.XLSX"  
    Application.Wait (Now + TimeValue("0:01:00")) 
    ' the slowest download time seems to be 10 seconds, J Bell failed @ home with c. 30 seconds 
    Workbooks("EXPORT.XLSX").Activate 
    On Error GoTo 0 
Loop

这样做的目的是开始按日期对名为export的文件进行排序，但并没有达到这一点。

此时打开的只是原始创建者表和标题为 Export.xlsx 的工作簿。

一切都工作正常，直到我昨天升级。

时间一开始设定为

Now + Timevalue ("0:00:10")

，以防需要更多时间。

如有任何帮助，我们将不胜感激

我期望发生的是文件

Export.xlsx

按日期排序。似乎与活动工作簿有关

Answer 1

这是处理潜在的多个 Excel 实例的一种方法：

Option Explicit

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

Sub Tester()
    Dim wb As Workbook
    
    Set wb = WaitForWorkbook("Temp.xlsx", 30)
    
    If Not wb Is Nothing Then
        Debug.Print "Got '" & wb.Name & "'"
        'work with `wb`
    Else
        Debug.Print "Wait timed out"
    End If

End Sub


Function WaitForWorkbook(wbName As String, Optional WaitForSeconds As Long = 30) As Workbook
    Dim xl As Application, t, wb As Workbook
    t = Timer
    Do While Timer - t < WaitForSeconds
        For Each xl In GetExcelInstances()
            For Each wb In xl.Workbooks
                If wb.Name = wbName Then
                    Set WaitForWorkbook = wb
                    Exit Function
                End If
            Next wb
        Next
        Application.Wait Now + TimeSerial(0, 0, 1)
        DoEvents
    Loop
End Function

Public Function GetExcelInstances() As Collection
  Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
  guid(0) = &H20400
  guid(1) = &H0
  guid(2) = &HC0
  guid(3) = &H46000000

  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
        On Error Resume Next 'ignore error on duplicate key
        GetExcelInstances.Add acc.Application, CStr(acc.Application.hwnd)
        On Error GoTo 0
    End If
  Loop
End Function