为什么我的VBA脚本无法从SAP导出excel文件？

Question

我有一个 Excel 宏/VBA 脚本，可将 SAP 中的表导出为 Excel 文件。然后它会激活这个新的 Excel 文件。这是我的代码的摘录：

session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell").selectedRows = ""
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell").contextMenu
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell").selectContextMenuItem "&XXL"
session.findById("wnd[1]/tbar[0]/btn[0]").press
filname = "Reuse_" & Date & Hour(Now) & ".xlsx"
session.findById("wnd[1]/usr/ctxt[1]").Text = filname
session.findById("wnd[1]/usr/ctxt[1]").caretPosition = 7
session.findById("wnd[1]/tbar[0]/btn[0]").press
Windows(filname).Activate

当我在 VBA 中使用调试器逐步运行它时，这是有效的。但是当我整体运行它时，它会中断，并显示两个弹出窗口。请注意，导出的 Excel 文件此时尚未打开（我认为这就是问题所在）。

一个 VBA 弹出窗口告诉我

运行时错误“9”：索引超出范围

还有一个 Excel 弹出窗口告诉我

Excel 无法执行所需的操作，因为对话框已打开

如果我单击 Excel 弹出窗口上的“确定”和 VBA 弹出窗口上的“调试”，则会同时发生两件事：

1. 上面代码中最后一行突出显示，表明VBA找不到导出的文件。
2. 所需的 Excel 文件立即打开（唉，太晚了）。

在激活导出的文件之前，我尝试在 SAP 或 Excel 中添加操作。但该文件当时也没有打开（仅在调试模式下）。我也尝试添加

Application.Wait

。

Answer 1

正如评论中所述，您出现此行为是因为您处于调试模式。如果您删除该行

Windows(filname).Activate

，一切都会正常运行。您遇到的问题是您想要获取 SAP 异步打开的 Excel 文件。触发导出的行之后的 Windows(filname).Activate 行将找不到您引用的文件，因为它太早了。

将以下代码放入模块中

    Option Explicit
    
    
    #If VBA7 Then
        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 IIDFromString Lib "ole32" _
                (ByVal lpsz As LongPtr, ByRef lpiid As GUID) As LongPtr
        Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" _
                (ByVal hWnd As LongPtr, ByVal dwId As LongPtr, ByRef riid As GUID, _
                ByRef ppvObject As Object) As LongPtr
    #Else
        Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" _
                (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
                 ByVal lpsz2 As String) As Long
        Private Declare Function IIDFromString Lib "ole32" _
                (ByVal lpsz As Long, ByRef lpiid As GUID) As Long
        Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
                (ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As GUID, _
                 ByRef ppvObject As Object) As Long
    #End If
    
            
    Private Type GUID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(7) As Byte
    End Type
    
    Private Const S_OK As Long = &H0
    Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
    Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0
Sub getWorkbook(wkbName As String, counter As Long)
    
    Const MAX_TRIES As Long = 10
    
    Dim wkb As Workbook
    Set wkb = getWkb(wkbName)
    If Not wkb Is Nothing Then
        
        ' Do your Stuff here
        If Not wkb Is Nothing Then
            MsgBox "Got you: " & wkb.Name
            Windows(wkbName).Activate
        End If

        Exit Sub
    Else
        counter = counter + 1
        If counter <= MAX_TRIES Then
            Application.OnTime Now + TimeValue("00:00:05"), "'getWorkbook""" & wkbName & """,""" & counter & "'"
        End If
    End If
       
End Sub
    Private Function getXLApp(hWinXL As Long, xlApp As Excel.Application) As Boolean
        ' Function GetXLApp(hWinXL As Long, xlApp As Object) As Boolean
        
        Dim hWinDesk As Long, hWin7 As Long
        Dim obj As Object
        Dim iid As GUID
        
        Call IIDFromString(StrPtr(IID_IDispatch), iid)
        hWinDesk = FindWindowEx(hWinXL, 0&, "XLDESK", vbNullString)
        hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)
        
        If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iid, obj) = S_OK Then
            Set xlApp = obj.Application
            getXLApp = True
        End If
    
    End Function
    Private Function getXLApps() As Collection
        
        Dim hWinXL As Long
        hWinXL = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
        
        Dim col As Collection
        Set col = New Collection
        
        Dim xlApp As Excel.Application
          Do While hWinXL > 0
                    
            If getXLApp(hWinXL, xlApp) Then
                col.Add xlApp
            End If
            
            hWinXL = FindWindowEx(0, hWinXL, "XLMAIN", vbNullString)
        
        Loop
        
        Set getXLApps = col
        
    End Function
    Private Function getWkb(wkbName As String) As Workbook
    
        Dim wb As Workbook
        Dim col As Collection
        Set col = getXLApps
        Dim i As Long, xlApp As Excel.Application
        For i = 1 To col.Count
            Set xlApp = col.Item(i)
            For Each wb In xlApp.Workbooks
                If wb.Name = wkbName Then
                    Set getWkb = wb
                    Exit Function
                    
                End If
            Next
        Next i
        Set wb = Nothing
    End Function

然后像这样调整你的代码

session.FindById("wnd[0]/usr/cntlGRID1/shellcont/shell").SelectedRows = ""
session.FindById("wnd[0]/usr/cntlGRID1/shellcont/shell").ContextMenu
session.FindById("wnd[0]/usr/cntlGRID1/shellcont/shell").SelectContextMenuItem "&XXL"
session.FindById("wnd[1]/tbar[0]/btn[0]").Press
filname = "Reuse_" & Date & Hour(Now) & ".xlsx"
session.FindById("wnd[1]/usr/ctxt[1]").Text = filname
session.FindById("wnd[1]/usr/ctxt[1]").CaretPosition = 7
session.FindById("wnd[1]/tbar[0]/btn[0]").Press

'Windows(filname).Activate
getWorkbook filename, 0