Search code examples
vbams-accessvbscriptsap-gui

How to trap any VBS error and return it to the calling VBA in Access


I have a program in Microsoft Access. I have VBS script files to automate SAP GUI screens ("transactions"). Using VBA in Access opens these different VBS script files using the Scriptcontrol object and performs a transaction in a SAP system.

Now, sometimes there is an error while running the transaction and then the script stops. I have written the error handler in every VBS script files.

My goal is that if there is an error in the SAP while running .VBS then it should close the active SAP session and store the status information in a string called "ScriptStatus". Then I pull this string to the calling vba back and again run the same .vbs script.

Code in the .VBS

    dim ScriptStatus
    
Function (DoWork) 
   
    If Not IsObject(application) Then
       Set SapGuiAuto  = GetObject("SAPGUI")
       Set application = SapGuiAuto.GetScriptingEngine
    End If
    If Not IsObject(connection) Then
       Set connection = application.Children(0)
    End If
    If Not IsObject(session) Then
       Set session    = connection.Children(0)
    End If
    If IsObject(WScript) Then
       WScript.ConnectObject session,     "on"
       WScript.ConnectObject application, "on"
    End If
    
    
    
    on error resume Next
    
    'SAP Code
    session.findById("wnd[0]").maximize
    'Furhter SAP Code
    'Change the ScriptStatus to completed
     ScriptStatus = "Script Completed"
    
    If Err.Number <> 0 Then
    'Change ScriptStatus
    ScriptStatus = "Script Error"
    'Close SAP Session
    session.findById("wnd[0]").Close
    End If

End Function

The code in the calling VBA

Sub Foo()
    Dim vbsCode As String, result As Variant, script As Object, ScriptInfo As String
    
    ReRunScript:

    '// load vbs source
    Open "x.vbs" For Input As #1
    vbsCode = Input$(LOF(1), 1)
    Close #1
    
    On Error GoTo ERR_VBS
    
    Set script = CreateObject("ScriptControl")
    script.Language = "VBScript"
    script.AddCode vbsCode
        
    result = script.Run("DoWork")
    ScriptInfo = script.Eval("ScriptStatus")
    If ScriptInfo = "Script Completed" Then 
    Exit Sub
    Elseif ScriptInfo = "Script Error" Then
    Goto ReRunScript
    End if

ERR_VBS:
    MsgBox Err.Description
 
    MsgBox script.Eval("ScriptStatus")
End Sub

Solution

  • Rather than running them via cscript you can execute them directly using the ScriptControl (32 bit only) - this would let you catch the errors directly in Access with a standard On Error (As well as allowing you to capture a return value).

    Example .VBS file:

    function DoWork
        '// do some work
        msgbox 1
        '// error
        x = 100 / 0
        DoWork = "OK"
    end function
    

    VBA:

    Sub Foo()
        Dim vbsCode As String, result As Variant
        
        '// load vbs source
        Open "x.vbs" For Input As #1
        vbsCode = Input$(LOF(1), 1)
        Close #1
        
        On Error GoTo ERR_VBS
        
        With CreateObject("ScriptControl")
            .Language = "VBScript"
            .AddCode vbsCode
            result = .Run("DoWork")
        End With
        
        Exit Sub
    
    ERR_VBS:
        MsgBox Err.Description
    End Sub
    

    Edit - To capture your Status variable make it global in the script (declared outside of a sub/function) and use the .Eval() method to read in in VBA.

    Example .VBS file:

    dim Status
    
    function DoWork
        '// do some work
        msgbox 1
    
        Status = "Hello World"
        
        '// error 
        x = 100 / 0
        DoWork = "OK"
    end function
    

    VBA:

    Sub Foo()
        Dim vbsCode As String, result As Variant, script As Object
        
        '// load vbs source
        Open "x.vbs" For Input As #1
        vbsCode = Input$(LOF(1), 1)
        Close #1
        
        On Error GoTo ERR_VBS
        
        Set script = CreateObject("ScriptControl")
        script.Language = "VBScript"
        script.AddCode vbsCode
            
        result = script.Run("DoWork")
        
        Exit Sub
    
    ERR_VBS:
        MsgBox Err.Description
        '// read VBS global
        MsgBox script.Eval("Status")
    End Sub