VBA错误处理的好模式

Question 1

在VBA中有哪些好的错误处理模式？

特别是在这种情况下，我该怎么办：

... some code ...
... some code where an error might occur ...
... some code ...
... some other code where a different error might occur ...
... some other code ...
... some code that must always be run (like a finally block) ...

我要处理这两个错误，并在可能发生错误的代码之后恢复执行。同样，无论最后抛出什么异常，都必须始终运行最后的最终代码。我怎样才能达到这个结果？

Question 2

VBA中的错误处理

On Error Goto ErrorHandlerLabel
Resume（Next| ErrorHandlerLabel）
On Error Goto 0 （禁用当前的错误处理程序）
Err 目的

Err在错误处理例程中，通常将对象的属性重置为零或长度为零的字符串，但是也可以使用显式完成Err.Clear。

错误处理例程中的错误正在终止。

513-65535范围适用于用户错误。对于自定义类错误，请添加vbObjectError到错误号。请参阅有关的MS文档Err.Raise和错误编号列表。

对于派生类中未实现的接口成员，应使用constant E_NOTIMPL = &H80004001。

Option Explicit

Sub HandleError()
  Dim a As Integer
  On Error GoTo errMyErrorHandler
    a = 7 / 0
  On Error GoTo 0

  Debug.Print "This line won't be executed."

DoCleanUp:
  a = 0
Exit Sub
errMyErrorHandler:
  MsgBox Err.Description, _
    vbExclamation + vbOKCancel, _
    "Error: " & CStr(Err.Number)
Resume DoCleanUp
End Sub

Sub RaiseAndHandleError()
  On Error GoTo errMyErrorHandler
    ' The range 513-65535 is available for user errors.
    ' For class errors, you add vbObjectError to the error number.
    Err.Raise vbObjectError + 513, "Module1::Test()", "My custom error."
  On Error GoTo 0

  Debug.Print "This line will be executed."

Exit Sub
errMyErrorHandler:
  MsgBox Err.Description, _
    vbExclamation + vbOKCancel, _
    "Error: " & CStr(Err.Number)
  Err.Clear
Resume Next
End Sub

Sub FailInErrorHandler()
  Dim a As Integer
  On Error GoTo errMyErrorHandler
    a = 7 / 0
  On Error GoTo 0

  Debug.Print "This line won't be executed."

DoCleanUp:
  a = 0
Exit Sub
errMyErrorHandler:
  a = 7 / 0 ' <== Terminating error!
  MsgBox Err.Description, _
    vbExclamation + vbOKCancel, _
    "Error: " & CStr(Err.Number)
Resume DoCleanUp
End Sub

Sub DontDoThis()

  ' Any error will go unnoticed!
  On Error Resume Next
  ' Some complex code that fails here.
End Sub

Sub DoThisIfYouMust()

  On Error Resume Next
  ' Some code that can fail but you don't care.
  On Error GoTo 0

  ' More code here
End Sub

Question 3

我还要补充：

全局Err对象是您最接近异常对象的对象
您可以有效地“抛出异常” Err.Raise

只是为了好玩：

On Error Resume Next 是恶魔的化身，应避免使用，因为它会默默地隐藏错误

Question 4

所以你可以做这样的事情

Function Errorthingy(pParam)
On Error GoTo HandleErr

 ' your code here

    ExitHere:
    ' your finally code
    Exit Function

    HandleErr:
        Select Case Err.Number
        ' different error handling here'
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "ErrorThingy"
        End Select


   Resume ExitHere

End Function

如果要烘烤自定义异常。（例如，违反业务规则的规则）使用上面的示例，但根据需要使用goto更改方法的流程。

Question 5

这是我的标准实现。我喜欢标签具有自我描述性。

Public Sub DoSomething()

    On Error GoTo Catch ' Try
    ' normal code here

    Exit Sub
Catch:

    'error code: you can get the specific error by checking Err.Number

End Sub

或者，用一个Finally块：

Public Sub DoSomething()

    On Error GoTo Catch ' Try

    ' normal code here

    GoTo Finally
Catch:

    'error code

Finally:

    'cleanup code

End Sub

Question 6

专业Excel开发具有很好的错误处理方案。如果您打算花任何时间在VBA上，那么值得一本书。VBA缺少许多领域，并且本书为管理这些领域提供了很好的建议。

PED描述了两种错误处理方法。主要的是一个系统，其中所有入口点过程都是子过程，而所有其他过程都是返回布尔值的函数。

入口点过程使用On Error语句按设计捕获错误。如果没有错误，则非入口点过程将返回True；如果存在错误，则将返回False。非入口点过程也使用On Error。

两种类型的过程都使用中央错误处理过程来使错误保持状态并记录错误。

Question 7

我使用自己开发的一段代码，这对我的代码非常有用：

在函数或子程序的开头，我定义：

On error Goto ErrorCatcher:

然后，我处理可能的错误

ErrorCatcher:
Select Case Err.Number

Case 0 'exit the code when no error was raised
    On Error GoTo 0
    Exit Function
Case 1 'Error on definition of object
    'do stuff
Case... 'little description here
    'do stuff
Case Else
    Debug.Print "###ERROR"
    Debug.Print "   • Number  :", Err.Number
    Debug.Print "   • Descrip :", Err.Description
    Debug.Print "   • Source  :", Err.Source
    Debug.Print "   • HelpCont:", Err.HelpContext
    Debug.Print "   • LastDLL :", Err.LastDllError
    Stop
    Err.Clear
    Resume
End Select

Question 8

这是一个相当不错的模式。

用于调试：出现错误时，按Ctrl-Break（或Ctrl-Pause），将中断标记（或任何它称为的东西）向下拖动到Resume行，按F8键，然后您将跳至“抛出”的行错误。

ExitHandler是您的“最终”。

沙漏每次都会被杀死。状态栏文本每次都会清除。

Public Sub ErrorHandlerExample()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset

    On Error GoTo ErrHandler
    Dim varRetVal As Variant

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("SomeTable", dbOpenDynaset, dbSeeChanges + dbFailOnError)

    Call DoCmd.Hourglass(True)

    'Do something with the RecordSet and close it.

    Call DoCmd.Hourglass(False)

ExitHandler:
    Set rst = Nothing
    Set dbs = Nothing
    Exit Sub

ErrHandler:
    Call DoCmd.Hourglass(False)
    Call DoCmd.SetWarnings(True)
    varRetVal = SysCmd(acSysCmdClearStatus)

    Dim errX As DAO.Error
    If Errors.Count > 1 Then
       For Each errX In DAO.Errors
          MsgBox "ODBC Error " & errX.Number & vbCrLf & errX.Description
       Next errX
    Else
        MsgBox "VBA Error " & Err.Number & ": " & vbCrLf & Err.Description & vbCrLf & "In: Form_MainForm", vbCritical
    End If

    Resume ExitHandler
    Resume

End Sub



    Select Case Err.Number
        Case 3326 'This Recordset is not updateable
            'Do something about it. Or not...
        Case Else
            MsgBox "VBA Error " & Err.Number & ": " & vbCrLf & Err.Description & vbCrLf & "In: Form_MainForm", vbCritical
    End Select

它还会捕获DAO和VBA错误。如果要捕获特定的错误号，可以在“ VBA错误”部分中放入“选择案例”。

Select Case Err.Number
    Case 3326 'This Recordset is not updateable
        'Do something about it. Or not...
    Case Else
        MsgBox "VBA Error " & Err.Number & ": " & vbCrLf & Err.Description & vbCrLf & "In: Form_MainForm", vbCritical
End Select

Question 9

下面的代码显示了一种替代方法，可确保子/功能只有一个出口点。

sub something()
    on error goto errHandler

    ' start of code
    ....
    ....
    'end of code

    ' 1. not needed but signals to any other developer that looks at this
    ' code that you are skipping over the error handler...
    ' see point 1...
    err.clear

errHandler:
    if err.number <> 0 then
        ' error handling code
    end if
end sub

Question 10

与讨论相关的还有相对未知的Erl功能。如果您的代码过程中包含数字标签，例如，

Sub AAA()
On Error Goto ErrorHandler

1000:
' code
1100:
' more code
1200:
' even more code that causes an error
1300:
' yet more code
9999: ' end of main part of procedure
ErrorHandler:
If Err.Number <> 0 Then
   Debug.Print "Error: " + CStr(Err.Number), Err.Descrption, _
      "Last Successful Line: " + CStr(Erl)
End If   
End Sub

该Erl函数返回最近遇到的数字行标签。在上面的示例中，如果在标签之后1200:但之前发生运行时错误1300:，则该Erl函数将返回1200，因为这最成功地遇到了行标签。我发现将行标签放在错误处理块的正上方是一个好习惯。我通常用它9999来表示该程序的主要部分已达到预期的预期效果。

笔记：

线标签必须是正整数-MadeItHere:不能用来代替Erl。
行标签与的实际行号完全无关VBIDE CodeModule。您可以按任意顺序使用所需的任何正数。在上面的示例中，只有25行左右的代码行，但是行标签号始于1000。与一起使用的编辑器行号和行标签号之间没有关系Erl。
线标签编号不需要按任何特定顺序排列，尽管如果它们不是按升序，自上而下的顺序排列，则其功效和益处Erl会大大降低，但Erl仍会报告正确的编号。
线标签特定于它们出现的过程。如果过程ProcA调用过程ProcB并且在ProcB将控制权传递回时发生错误ProcA，Erl（in ProcA）将返回ProcA调用前最近遇到的行标签号ProcB。从内部ProcA，您将无法获得可能出现在其中的行标签号ProcB。

将行号标签放入循环中时请多加注意。例如，

For X = 1 To 100
500:
' some code that causes an error
600:
Next X

如果行标签之后500但之前的代码600导致错误，并且该错误在循环的第20次迭代中发生，Erl则500即使600在之前的19个循环中成功遇到了该错误，也将返回。

在过程中正确放置线标签对于使用该Erl功能获取真正有意义的信息至关重要。

网上有任意数量的免费实用程序会自动在过程中插入数字行标签，因此在开发和调试时，您可以获得细粒度的错误信息，然后在代码上线后删除这些标签。

如果您的代码在发生意外错误时向最终用户显示错误信息，则从Erl该信息中提供值可以使查找和解决问题的方式比Erl未报告值时更简单。

Question 11

我发现以下方法最有效，称为中央错误处理方法。

好处

您有两种运行应用程序的模式：Debug和Production。在“调试”模式下，代码将在出现任何意外错误时停止，并允许您通过按两次F8跳到出现错误的行来轻松调试。在生产模式下，有意义的错误消息将显示给用户。

您可以抛出这样的故意错误，这将停止执行代码并向用户发送消息：

Err.Raise vbObjectError, gsNO_DEBUG, "Some meaningful error message to the user"

Err.Raise vbObjectError, gsUSER_MESSAGE, "Some meaningful non-error message to the user"

'Or to exit in the middle of a call stack without a message:
Err.Raise vbObjectError, gsSILENT

实作

您需要使用大量的代码“包裹”所有子例程和函数，并带有以下页眉和页脚，并确保ehCallTypeEntryPoint在所有入口点中指定。还要注意msModule常量，该常量必须放在所有模块中。

Option Explicit
Const msModule As String = "<Your Module Name>"

' This is an entry point 
Public Sub AnEntryPoint()
    Const sSOURCE As String = "AnEntryPoint"
    On Error GoTo ErrorHandler

    'Your code

ErrorExit:
    Exit Sub

ErrorHandler:
    If CentralErrorHandler(Err, ThisWorkbook, msModule, sSOURCE, ehCallTypeEntryPoint) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If
End Sub

' This is any other subroutine or function that isn't an entry point
Sub AnyOtherSub()
    Const sSOURCE As String = "AnyOtherSub"
    On Error GoTo ErrorHandler

    'Your code

ErrorExit:
    Exit Sub

ErrorHandler:
    If CentralErrorHandler(Err, ThisWorkbook, msModule, sSOURCE) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If
End Sub

中央错误处理程序模块的内容如下：

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments: Error handler code.
'
'           Run SetDebugMode True to use debug mode (Dev mode)
'           It will be False by default (Production mode)
'
' Author:   Igor Popov
' Date:     13 Feb 2014
' Licence:  MIT
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit
Option Private Module

Private Const msModule As String = "MErrorHandler"

Public Const gsAPP_NAME As String = "<You Application Name>"

Public Const gsSILENT As String = "UserCancel"  'A silent error is when the user aborts an action, no message should be displayed
Public Const gsNO_DEBUG As String = "NoDebug"   'This type of error will display a specific message to the user in situation of an expected (provided-for) error.
Public Const gsUSER_MESSAGE As String = "UserMessage" 'Use this type of error to display an information message to the user

Private Const msDEBUG_MODE_COMPANY = "<Your Company>"
Private Const msDEBUG_MODE_SECTION = "<Your Team>"
Private Const msDEBUG_MODE_VALUE = "DEBUG_MODE"

Public Enum ECallType
    ehCallTypeRegular = 0
    ehCallTypeEntryPoint
End Enum

Public Function DebugMode() As Boolean
    DebugMode = CBool(GetSetting(msDEBUG_MODE_COMPANY, msDEBUG_MODE_SECTION, msDEBUG_MODE_VALUE, 0))
End Function

Public Sub SetDebugMode(Optional bMode As Boolean = True)
    SaveSetting msDEBUG_MODE_COMPANY, msDEBUG_MODE_SECTION, msDEBUG_MODE_VALUE, IIf(bMode, 1, 0)
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments: The central error handler for all functions
'           Displays errors to the user at the entry point level, or, if we're below the entry point, rethrows it upwards until the entry point is reached
'
'           Returns True to stop and debug unexpected errors in debug mode.
'
'           The function can be enhanced to log errors.
'
' Date          Developer           TDID    Comment
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 13 Feb 2014   Igor Popov                  Created

Public Function CentralErrorHandler(ErrObj As ErrObject, Wbk As Workbook, ByVal sModule As String, ByVal sSOURCE As String, _
                                    Optional enCallType As ECallType = ehCallTypeRegular, Optional ByVal bRethrowError As Boolean = True) As Boolean

    Static ssModule As String, ssSource As String
    If Len(ssModule) = 0 And Len(ssSource) = 0 Then
        'Remember the module and the source of the first call to CentralErrorHandler
        ssModule = sModule
        ssSource = sSOURCE
    End If
    CentralErrorHandler = DebugMode And ErrObj.Source <> gsNO_DEBUG And ErrObj.Source <> gsUSER_MESSAGE And ErrObj.Source <> gsSILENT
    If CentralErrorHandler Then
        'If it's an unexpected error and we're going to stop in the debug mode, just write the error message to the immediate window for debugging
        Debug.Print "#Err: " & Err.Description
    ElseIf enCallType = ehCallTypeEntryPoint Then
        'If we have reached the entry point and it's not a silent error, display the message to the user in an error box
        If ErrObj.Source <> gsSILENT Then
            Dim sMsg As String: sMsg = ErrObj.Description
            If ErrObj.Source <> gsNO_DEBUG And ErrObj.Source <> gsUSER_MESSAGE Then sMsg = "Unexpected VBA error in workbook '" & Wbk.Name & "', module '" & ssModule & "', call '" & ssSource & "':" & vbCrLf & vbCrLf & sMsg
            MsgBox sMsg, vbOKOnly + IIf(ErrObj.Source = gsUSER_MESSAGE, vbInformation, vbCritical), gsAPP_NAME
        End If
    ElseIf bRethrowError Then
        'Rethrow the error to the next level up if bRethrowError is True (by Default).
        'Otherwise, do nothing as the calling function must be having special logic for handling errors.
        Err.Raise ErrObj.Number, ErrObj.Source, ErrObj.Description
    End If
End Function

要将自己设置为“调试”模式，请在“立即”窗口中运行以下命令：

SetDebugMode True

Question 12

当心大象陷阱：

在这次讨论中，我没有提到这一点。[Access 2010]

ACCESS / VBA如何处理CLASS对象中的错误由一个可配置的选项决定：

VBA代码编辑器>工具>选项>常规>错误捕获：

Question 13

我对此线程前面的声明的个人看法：

只是为了好玩：

On Error Resume Next是魔鬼的化身，应该避免，因为它无声地隐藏了错误。

我正在使用On Error Resume Nexton过程，在该过程中，我不想让错误停止我的工作，并且其中任何语句都不依赖于先前语句的结果。

执行此操作时，我添加了一个全局变量debugModeOn并将其设置为True。然后我用这种方式：

If not debugModeOn Then On Error Resume Next

在交付工作时，我将变量设置为false，从而仅向用户隐藏错误并在测试过程中显示错误。

在执行可能会失败的事情（例如，调用可能为空的ListObject的DataBodyRange）时也使用它：

On Error Resume Next
Sheet1.ListObjects(1).DataBodyRange.Delete
On Error Goto 0

代替：

If Sheet1.ListObjects(1).ListRows.Count > 0 Then 
    Sheet1.ListObjects(1).DataBodyRange.Delete
End If

或检查集合中某项的存在：

On Error Resume Next
Err.Clear
Set auxiliarVar = collection(key)

' Check existence (if you try to retrieve a nonexistant key you get error number 5)
exists = (Err.Number <> 5)