VBA 有时无法识别已通过 SAP GUI 脚本打开的 Excel 文件

Question

我每天在 VBA 中运行一个 SAP GUI 脚本。 在脚本中，我将一些数据从 SAP 导出到几个不同的 Excel 文件，并将这些文件保存到网络驱动器。 在第一个宏中，我导出数据。 在第二个中，我将数据复制到与脚本所在的工作簿相同的工作簿中。

有时我会遇到运行时错误

下标超出范围

在Set ws2 = Workbooks("FEBA_EXPORT_" & today2 & ".XLSX").Worksheets("Sheet1")上。

看起来 Excel 文件未被识别为打开。 我手动关闭文件，然后重新打开它，然后脚本将运行。

我试图在给出错误的Set ws2行前面插入以下代码，并且此代码始终给出文件已打开的消息。

Dim Ret
Ret = IsWorkBookOpen(filepath & "FEBA_EXPORT_" & today2 & ".XLSX")
If Ret = True Then
    MsgBox "File is open"
Else
    MsgBox "File is Closed"
End If

这是 function：

Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
    Case 0:    IsWorkBookOpen = False
    Case 70:   IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function

这是代码的相关部分：

Sub CopyExportedFEBA_ExtractFEBRE()

    Dim SapGuiAuto As Object
    Dim SAPApp As Object
    Dim SAPCon As Object
    Dim session As Object

    Set SapGuiAuto = GetObject("SAPGUI")
    Set SAPApp = SapGuiAuto.GetScriptingEngine
    Set SAPCon = SAPApp.Children(0)
    Set session = SAPCon.Children.ElementAt(0) ' <--- Assumes you are using the first session open. '
    
    Dim ws0, ws1, ws2, ws6, ws7 As Worksheet
    
    Set ws0 = Workbooks("FEB_BSPROC.xlsm").Worksheets("INPUT")
    Set ws1 = Workbooks("FEB_BSPROC.xlsm").Worksheets("FEB_BSPROC")
    Set ws6 = Workbooks("FEB_BSPROC.xlsm").Worksheets("FBL3N_1989")
    
    Dim today2, filepath As String
    today2 = ws0.Range("E2")
    filepath = ws0.Range("A7")
    
    ' Check if  if FEBA_EXPORT wb is open
    ' This is giving the message that the file is open
    
    Dim Ret
    Ret = IsWorkBookOpen(filepath & "FEBA_EXPORT_" & today2 & ".XLSX")
    If Ret = True Then
        MsgBox "File is open"
    Else
        MsgBox "File is Closed"
    End If
    
    ' This is giving runtime error 9 Subscript out of range
    ' If manually close the Excel and the  reopen, then it will always work after this
    Set ws2 = Workbooks("FEBA_EXPORT_" & today2 & ".XLSX").Worksheets("Sheet1")
    
    'This is never giving any errors
    Set ws7 = Workbooks("1989_" & today2 & ".XLSX").Worksheets("Sheet1")

文件filepath变量是网络驱动器的完整文件路径。 所以这不是问题。 此外，我还有另一个 Excel 文件，它以相同的方式打开，并且从未给出任何错误。
today2变量也是正确的。

我认为如果我可以使用ws2关闭 ws2 工作簿然后重新打开它，它会起作用。 所以我试图关闭它而不将其设置为变量，但后来我得到了同样的错误。

当您将任何内容导出到 Excel 文件时，使用 SAP GUI 脚本，文件将在保存后自动打开。 我想知道这可能是问题吗？ 我只对这个 Excel 文件有问题，而其他几个以相同方式保存和打开的文件没有问题。

Answer 1

正如我在上面的评论中所说，工作簿可能在新的 session 中打开，与代码运行的不同。 请使用下一个 function 来识别是否是不同的 Excel session 问题：

Function sameExSession(wbFullName As String, Optional boolClose As Boolean) As Boolean
   Dim sessEx As Object, wb As Object
  
   Set sessEx = GetObject(wbFullName).Application
   If sessEx.hwnd = Application.hwnd Then
        sameExSession = True
   Else
        sameExSession = False
        If boolClose Then
            sessEx.Workbooks(Right(wbFullName, Len(wbFullName) - InStrRev(wbFullName, "\"))).Close False
            sessEx.Quit: Set sessEx = Nothing
        End If
   End If
End Function

It identify the session where the workbook is open, then compare its handle with the active session one and if not the same, close the workbook (if calling the function with second parameter as True ), quit the session and returns False . 如果只是检查，则调用 function，第二个参数为False （工作簿不会关闭，session 仍将保留）。

可以通过以下方式使用：

Sub testSameExSession()
   Dim wbFullName As String, wbSAP As Workbook
   wbFullName = filepath & "FEBA_EXPORT_" & today2 & ".XLSX"
   If sameExSession(wbFullName, True) Then
        Debug.Print "The same session"
        Set wbSAP = Workbooks("FEBA_EXPORT_" & today2 & ".XLSX")
   Else
        Debug.Print "Different session..."
        Set wbSAP = Workbooks.Open(wbFullName)        
   End If
   Debug.Print wbSAP.Name
   'use the set workbook to do what you need...
End Sub

当您遇到所描述的问题时，请使用上述方式测试是否是不同会话的问题。

如果是这样，我认为很容易在现有代码中输入这部分。 如果工作簿将在不同的 session 中打开，则无需手动关闭（并重新打开），上面的 function 就可以了...

Answer 2

如果有人仍然面临这个问题，我找到了一种方法来等待从 SAP 及其应用程序实例下载的 excel 文件打开，然后关闭它们，让您轻松处理这些文件。 您也可以设置超时。

如果在已经打开的 excel 实例中下载并打开文件，它只会关闭文件而不是整个实例。

您可以按如下方式使用它：

Sub Test()
    Call Close_SAP_Excel("Test.xlsx", "Test2.xlsx")
End Sub

xCloseExcelFromSAP

#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

Sub Close_SAP_Excel(ParamArray FileNames())
    'Procedure to close files downloaded from SAP and at the same time close the Excel application instance that will be open with them.

    Dim ExcelAppSAP As Variant
    Dim ExcelFile As Variant
    Dim FinishedLoop As Boolean, TimeoutReached As Boolean, FileClosed As Boolean
    Dim ReTry As Long
    Dim i As Long, x As Long
    
    Set ExcelAppSAP = Nothing
    ReTry = 100000 'Used as Timeout 100000 = ~10 seconds
    i = 1
    
    'The following loop is executed until excel file is closed.
    'Inside of this, there is a For Loop for each Excel Instance and inside of that is another loop
    'for each excel inside the instance. If name matches, it is closed.
    Do While Not FinishedLoop
        If i > ReTry Then
            TimeoutReached = True
            Exit Do
        End If
        
        For Each ExcelFile In GetExcelInstances() 'Function to Get Excel Open Instances
            For Each xls In ExcelFile.Workbooks
                For x = LBound(FileNames()) To UBound(FileNames())
                    If xls.Name = FileNames(x) Then
                    
                        Set ExcelAppSAP = ExcelFile 'Set Instance opened by SAP to variable
                        'Here add actions if needed. Reference to workbook as xls e.g.: xls.Sheets(1).Range("A1").Copy
                        xls.Close SaveChanges:=False
                        FileClosed = True
                    
                    End If
                Next x
            Next
        Next
        
        If FileClosed Then
            FinishedLoop = True
        End If
        i = i + 1
    Loop
    
    ThisWorkbook.Activate

    If Not TimeoutReached Then
        If FileClosed Then
            On Error Resume Next
            If ExcelAppSAP.Workbooks.Count = 0 Then
                ExcelAppSAP.Quit
            End If
        Else
            MsgBox "Excel application instance from SAP was not closed correctly. Please close it manually or try again.", , "Error"
        End If
    Else
        MsgBox "Max timeout reached", , "Error"
    End If

End Sub
     
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
      GetExcelInstances.Add acc.Application
    End If
  Loop
End Function