Excel VBA 使用用户定义的类型进行错误处理答案

【问题标题】：Excel VBA On Error handling with User-Defined TypeExcel VBA 使用用户定义的类型进行错误处理
【发布时间】：2016-07-21 12:39:28
【问题描述】：

这是一个以编程方式为 API 安装类型库的示例子程序。为什么错误处理例程会失败？我尝试遵循我在 Python 中熟悉的 try...except...finally 策略。

Sub CopyViewLayout():

'TRY:
On Error GoTo addReference
    Dim App As femap.model
    'COMPILE ERROR: USER TYPE NOT DEFINED

ResumeSub:
    Dim App As femap.model
    Set App = GetObject(, "femap.model")
    Dim rc As Variant
    Dim feView As femap.View
    Set feView = App.feView
    rc = feView.Get(0)

Exit Sub

'EXCEPT:
addReference:
    Dim vbaEditor As VBIDE.VBE
    Dim vbProj As VBIDE.VBProject
    Dim checkRef As VBIDE.Reference
    Dim filepath As String

    Set vbaEditor = Application.VBE
    Set vbProj = ActiveWorkbook.VBProject

    filepath = "C:\apps\FEMAPv11\"

    On Error GoTo Failure
    vbProj.References.AddFromFile (filepath & "femap.tlb")
    Set vbProj = Nothing
    Set vbaEditor = Nothing
    GoTo ResumeSub

'FINALLY
Failure:
    MsgBox ("couldn't find type library, exiting sub")

End Sub

编辑

我从 main 中分出这一部分，因为 VBA 中的错误处理太荒谬了……对我来说更好的方法是使用布尔值实现 finite-state-machine。

回答

Sub refcheck()
Dim i As Long
Dim FEMAP_GUID As String
FEMAP_GUID = "{08F336B3-E668-11D4-9441-001083FFF11C}"
With ActiveWorkbook.VBProject.references
    For i = 1 To .Count
        If .Item(i).GUID = FEMAP_GUID Then
            Exit For
        Else
            'note: filepath is determined using Dir() elsewhere...
            .AddFromFile (filepath & "femap.tlb")
            Exit For
        End If
    Next
End With
End Sub

【问题讨论】：

VBA 中的错误处理不能像try...catch 那样工作——试图模仿它只会导致痛苦和痛苦。 Handle runtime errors the way they're supposed to be
错误处理对我来说可能是最难的挑战。为了解决这个问题，我绘制了我的依赖项和子项的流程图/路线图，并创建了一组模块范围的布尔值，它们充当“门”中的“键”，其中门是 main 中的键相关调用。
编辑问题的答案会破坏 Stack Overflow 的问答性质。您可能应该发布答案。
@Mat'sMug，好的，我会的。谢谢。

标签： vba excel

【解决方案1】：

错误处理只处理运行时错误；不是编译时错误。使用

Dim App as Object

并确保您的代码中只使用一次Dim App。

通过使用As Object，您可以将任何对象后期绑定到它。你在编码时失去了智能感知。

【讨论】：

【解决方案2】：

就像 Dick 提到的，使用后期装订，但仅此还不够。您必须使用正确的错误处理来使用它。

例如

Dim App As Object

On Error Resume Next
Set App = GetObject(, "femap.model")
On Error GoTo 0

If App Is Nothing Then
    MsgBox "Please check if femap is installed"
    Exit Sub
End If

'
'~~> Rest of the code
'

如果您确定它已安装，那么您将收到错误，因为未引用相关库。为此，我建议您查看How to add a reference programmatically

不过，我仍然建议您采用后期装订路线。

【讨论】：