如何捕获VBS所有错误并返回给Access中调用它的VBA程序

现有代码存在的问题 #

• VBS函数定义语法错误：Function (DoWork) 写法不符合VBS语法规范，会直接触发编译错误
• 错误捕获范围不完整：On Error Resume Next 放置位置晚于SAP连接逻辑，连接阶段的报错无法被捕获
• ScriptControl环境兼容问题：VBS中调用WScript.ConnectObject的逻辑在VBA调用的ScriptControl执行环境下不存在WScript对象，会直接触发报错
• 无重试次数限制：VBA侧的重试逻辑没有设置最大重试次数，一旦脚本持续出错会进入无限循环
• 会话关闭逻辑鲁棒性不足：报错时直接调用session对象方法，如果session对象已经失效会触发二次错误

修正后的VBS脚本代码 #

Dim ScriptStatus

Function DoWork
    ScriptStatus = "" ' 初始化状态
    On Error Resume Next
    
    ' 适配ScriptControl运行环境，跳过WScript相关逻辑
    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 Err.Number <> 0 Then
        ScriptStatus = "SAP Connection Error"
        ' 清理失效对象
        Set session = Nothing
        Set connection = Nothing
        Set application = Nothing
        Set SapGuiAuto = Nothing
        Exit Function
    End If
    
    ' SAP业务操作逻辑
    session.findById("wnd[0]").maximize
    ' 此处放置其他SAP事务操作代码
    
    If Err.Number = 0 Then
        ScriptStatus = "Script Completed"
    Else
        ScriptStatus = "Script Error: " & Err.Description
        ' 安全关闭会话，避免残留
        If Not session Is Nothing Then
            On Error Resume Next
            session.findById("wnd[0]").Close
            On Error GoTo 0
        End If
        ' 清理所有会话相关对象，避免下次重试引用旧对象
        Set session = Nothing
        Set connection = Nothing
        Set application = Nothing
        Set SapGuiAuto = Nothing
    End If
    On Error GoTo 0
End Function

修正后的VBA调用代码 #

Sub Foo()
    Const MAX_RETRY As Integer = 3 ' 设置最大重试次数，避免死循环
    Dim vbsCode As String, result As Variant, script As Object, ScriptInfo As String
    Dim retryCount As Integer
    
    retryCount = 0
ReRunScript:
    retryCount = retryCount + 1
    If retryCount > MAX_RETRY Then
        MsgBox "脚本连续失败" & MAX_RETRY & "次，已终止运行", vbCritical
        Exit Sub
    End If
    
    ' 加载VBS源码
    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
        MsgBox "脚本执行成功", vbInformation
        Exit Sub
    ElseIf InStr(ScriptInfo, "Script Error") > 0 Or InStr(ScriptInfo, "SAP Connection Error") > 0 Then
        ' 等待1秒再重试，避免SAP系统还没释放资源
        Application.Wait (Now + TimeValue("0:00:01"))
        GoTo ReRunScript
    End If

ERR_VBS:
    MsgBox "调用VBS出错：" & Err.Description, vbCritical
    If Not script Is Nothing Then
        On Error Resume Next
        MsgBox "VBS返回状态：" & script.Eval("ScriptStatus")
        On Error GoTo 0
    End If
End Sub

逻辑说明 #

• 移除了VBS中不兼容ScriptControl环境的WScript相关代码，避免环境报错
• 扩大了错误捕获范围，连接阶段和业务操作阶段的报错都可以被捕获
• 报错后主动清理所有SAP相关对象，避免下次重试时引用已经失效的旧会话对象
• VBA侧增加最大重试次数限制，同时重试前增加1秒等待时间，给SAP系统留出资源释放的窗口
• 状态信息附带错误描述，方便排查问题

内容的提问来源于stack exchange，提问作者Goku