如何在VBA中捕获无返回值的COM方法抛出的错误？

方法1：修改COM组件，将Sub改为返回HRESULT的Function #

如果有权限修改COM组件代码，最直接的方式是把无返回值的Sub改成返回HRESULT的Function。这样VBA调用时可以直接获取返回码，判断是否为S_OK（&H0）或DISP_E_EXCEPTION（&H80020009）。

COM组件端示例（C++/ATL）：

// 原Sub实现
STDMETHODIMP CMyComClass::MyMethod()
{
    if (someErrorCondition)
    {
        return AtlReportError(GetObjectCLSID(), L"Error message", IID_IMyComInterface, DISP_E_EXCEPTION);
    }
    return S_OK;
}

// 修改为返回HRESULT的Function
STDMETHODIMP_(HRESULT) CMyComClass::MyMethod()
{
    if (someErrorCondition)
    {
        return AtlReportError(GetObjectCLSID(), L"Error message", IID_IMyComInterface, DISP_E_EXCEPTION);
    }
    return S_OK;
}

VBA端调用示例：

Dim comObj As New MyComClass
Dim hResult As Long

hResult = comObj.MyMethod()
If hResult <> &H0 Then ' 判断是否为S_OK
    If hResult = &H80020009 Then ' 判断是否为DISP_E_EXCEPTION
        Debug.Print "COM方法抛出DISP_E_EXCEPTION异常"
    Else
        Debug.Print "COM方法返回错误码: " & Hex(hResult)
    End If
End If

方法2：在VBA中手动调用IDispatch::Invoke获取HRESULT #

如果无法修改COM组件，可以通过手动调用IDispatch::Invoke绕过VBA对Sub返回码的忽略，直接获取HRESULT。

VBA示例代码：

Option Explicit

Private Const DISP_E_EXCEPTION As Long = &H80020009
Private Const S_OK As Long = &H0
Private Const DISPATCH_METHOD As Long = &H1

' 声明oleaut32.dll中的DispInvoke函数
Private Declare Function DispInvoke Lib "oleaut32.dll" ( _
    ByVal pDisp As Object, _
    ByVal riid As Long, _
    ByVal lcid As Long, _
    ByVal wFlags As Long, _
    ByVal pDispParams As Long, _
    ByVal pVarResult As Long, _
    ByVal pExcepInfo As Long, _
    ByVal puArgErr As Long _
) As Long

Sub CheckComMethodError()
    Dim comObj As Object
    Dim hResult As Long
    
    Set comObj = CreateObject("MyComClass.MyMethod")
    
    ' 调用Invoke执行COM方法并获取HRESULT
    hResult = DispInvoke(comObj, 0, 0, DISPATCH_METHOD, 0, 0, 0, 0)
    
    If hResult <> S_OK Then
        If hResult = DISP_E_EXCEPTION Then
            Debug.Print "COM方法抛出DISP_E_EXCEPTION异常"
        Else
            Debug.Print "COM方法返回错误码: " & Hex(hResult)
        End If
    End If
End Sub

方法3：使用GetErrorInfo获取COM错误信息 #

即使VBA的On Error无法直接捕获，也可以调用GetErrorInfo API获取COM抛出的错误对象，进而判断是否存在异常。

VBA示例代码：

Option Explicit

Private Const DISP_E_EXCEPTION As Long = &H80020009

' 声明oleaut32.dll中的GetErrorInfo函数
Private Declare Function GetErrorInfo Lib "oleaut32.dll" ( _
    ByVal dwReserved As Long, _
    ByRef ppErrorInfo As Object _
) As Long

Sub CheckComErrorInfo()
    Dim comObj As Object
    Dim errInfo As Object
    Dim hResult As Long
    
    Set comObj = CreateObject("MyComClass.MyMethod")
    
    On Error Resume Next ' 开启错误续行，避免VBA直接抛出未处理错误
    comObj.MyMethod ' 调用COM Sub方法
    On Error GoTo 0
    
    ' 获取错误信息对象
    hResult = GetErrorInfo(0, errInfo)
    If Not errInfo Is Nothing Then
        ' 检查错误码是否为DISP_E_EXCEPTION
        If errInfo.GetErrorInfo = DISP_E_EXCEPTION Then
            Debug.Print "COM方法抛出DISP_E_EXCEPTION异常，错误描述: " & errInfo.GetDescription
        End If
        Set errInfo = Nothing
    End If
End Sub

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