CODEWITHSUNDEEP
vbams-accessvbscriptsap-gui
Goku
Goku

Reputation: 89

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

Upvotes: 1

Views: 575

Answers (1)

Alex K.
Alex K.

Reputation: 175896

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

Upvotes: 3

Related Questions