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

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 WScript.Shell 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 as follows:

If Err.Number <> 0 Then
    MsgBox ("It failed")
    
    'Close the SAP session
    session.findById("wnd[0]").Close
    
End If
    
Sub ShowError(strMessage)
    WScript.Echo strMessage
    WScript.Echo Err.Number & " Srce: " & Err.Source & " Desc: " &  Err.Description
    Err.Clear
End Sub

Now I want to send this error number (Err.Number) or some information that there was an error in the script to the active Access database.

How do I do it?

I tried this but it gives me an error that the database is locked!

    dim accessApp
    set accessApp = createObject("Access.Application")
    accessApp.visible = true
    accessApp.OpenCurrentDataBase("C:\path.accdb")

My real goal is that whenever there is an error after each VBS file is being executed in the SAP system then I get the error information in Access and then using VBA I will detect this and tell the program to execute the VBS file again.

Any lead would be great help!

CodePudding user response：

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