首先,我对 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
按日期排序。似乎与活动工作簿有关
这是处理潜在的多个 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