Search code examples
vbaexcelvbscriptadsutil.vbs

Error handling on VBScript: Not throwing error


If error occured then it's going to sub DisplayCustomError but it's not throwing exception. Expected result - After objHTTP.send (json) it should throw exception message. I have tried Call Err.Raise but it's not throwing anything. The code is in VBscript

 sub run
 On Error Resume Next
    wrapper.getVariable( "Plant_Price_PerKW" ).value = excel.range( "'Cases'!$H$331" )
    wrapper.getVariable( "Net_Present_Value" ).value = excel.range( "'Cases'!$H$782" )
    wrapper.getVariable( "IRR" ).value = excel.range( "'Cases'!$H$783" )
 Dim strMessage
    If Err.Number <> 0 And excel.range( "'Cases'!$H$783" ) = "" Then
     strMessage = "IRR cannot be computed. "
     DisplayCustomError(strMessage)
     WScript.Quit 
    ElseIf Err.Number <> 0 And (excel.range( "'Cases'!$H$783" ) <> "") Then
     strMessage = "Other Outputs cannot be computed."
     DisplayCustomError(strMessage)
     WScript.Quit 
    End If
end sub

Sub DisplayCustomError(strMessage)
If Err.Number <> 0 Then
    Dim errorMessage, objHTTP, URL, json, errorCode, uniqueId, networkInfo, jobId
    errorMessage ="Error while executing EVMLite. Error number " & Err.Number & ". " & Err.Description & " " & Err.Source & strMessage
    errorCode = "ERR-1004"
    uniqueId = wrapper.getVariable("UniqueId").value
    Set networkInfo = CreateObject("WScript.NetWork") 
    jobId = networkInfo.ComputerName
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")    
    URL = "http://10.93.244.224343:9005/vpp/logerror"
    objHTTP.Open "POST", URL, False
    objHTTP.SetRequestHeader "Content-Type", "application/json"
    json = "{""jobId"": """& jobId &""", ""uniqueId"": """& uniqueId &""", ""errorCode"": """& errorCode &""", ""errorMessage"": """& errorMessage &"""}"
    'MsgBox json
    objHTTP.send (json)

    On Error Goto 0

    Call Err.Raise(vbObjectError + 10, "EVM Failed to execute", errorMessage)
    'MsgBox objHTTP.ResponseText

 End If
end sub

Solution

  • The funny thing about VBScript's implementation of On Error is that it is not global - it is actually restricted by scope. So, if you apply On Error Resume Next in a Sub or Function and then enter a new Function or Sub that turns it off, that setting gets reverted when the Sub or Function exits.

    In your case, your Sub run sets On Error Resume Next and it then calls Sub DisplayCustomError which sets On Error GoTo 0. That only applies while you're still inside DisplayCustomError. When it exits due to Err.Raise, your Sub run will carry on, because in that scope, it's still set to On Error Resume Next.

    You will need to explicitly state On Error GoTo 0 within Sub run before you make the call to DisplayCustomError

    Here's an example VBS file you can test. If you run this, nothing will be thrown and the program will show the message "Done". If you uncomment the line in Sub1, then it'll raise the error "Example 2".

    Sub Sub1()
        On Error Resume Next
        Err.Raise 1, "Example 1"
        'On Error Goto 0
        Sub2
    End Sub
    
    Sub Sub2()
        On Error Goto 0
        Err.Raise 2, "Example 2"
    End Sub
    
    Sub1
    WScript.Echo "Done"