正确处理VBA中的错误(Excel)

Question

我已经和VBA合作了很长一段时间了,但我对错误处理仍然不太了解.

一篇好文章是CPearson.com的文章

但是我仍然想知道我以前使用ErrorHandling的方式是否完全错误: 第1块

On Error Goto ErrCatcher
   If UBound(.sortedDates) > 0 Then

       // Code

   Else
ErrCatcher:
       // Code

   End If

if子句,因为如果它是真的,它将被执行,如果它失败,Goto将进入Else-part,因为数组的Ubound不应该为零或更少,没有Error,这种方法工作得很好至今.

如果我理解正确,它应该是这样的: 第2块

On Error Goto ErrCatcher
    If Ubound(.sortedDates) > 0 Then

       // Code
    End If

    Goto hereX

ErrCatcher:
       //Code
    Resume / Resume Next / Resume hereX

hereX:

或者甚至像这样: 第3座

On Error Goto ErrCatcher
    If Ubound(.sortedDates) > 0 Then

       // Code
    End If

ErrCatcher:
    If Err.Number <> 0 then
       //Code
    End If

我看到的最常见的方式是,一个错误"Catcher"位于sub的末尾,Sub实际上以"Exit Sub"结束,但是如果Sub是相当的话,它不会有点混乱如果你反之亦然阅读代码？

第4座

以下代码的来源: CPearson.com

  On Error Goto ErrHandler:
   N = 1 / 0    ' cause an error
   '
   ' more code
   '
  Exit Sub

  ErrHandler:

   ' error handling code'

   Resume Next

End Sub 

它应该像3区块一样吗？

感谢您阅读我的问题Greetings skofgar

Answer 1

你有一个来自ray023的真正奇妙的答案,但你的评论可能是过度杀戮很容易.对于"更轻"的版本....

块1是,恕我直言,不好的做法.正如osknows已经指出的那样,将错误处理与正常路径代码混合是不好的.首先,如果在出现错误条件时抛出新错误,您将无法处理它(除非您从一个也有错误处理程序的例程调用,执行将"冒泡" ).

块2看起来像是模仿Try/Catch块.应该没问题,但这不是VBA方式.块3是块2的变体.

Block 4是The VBA Way的简单版本.我强烈建议使用它,或类似的东西,因为这是任何其他VBA程序员在代码中所期望的.但是,让我展示一个小扩展:

Private Sub DoSomething()
On Error GoTo ErrHandler

'Dim as required

'functional code that might throw errors

ExitSub:
    'any always-execute (cleanup?) code goes here -- analagous to a Finally block.
    'don't forget to do this -- you don't want to fall into error handling when there's no error
    Exit Sub

ErrHandler:
    'can Select Case on Err.Number if there are any you want to handle specially

    'display to user
    MsgBox "Something's wrong: " & vbCrLf & Err.Description

    'or use a central DisplayErr routine, written Public in a Module
    DisplayErr Err.Number, Err.Description

    Resume ExitSub
    Resume
End Sub

请注意第二Resume.这是我最近学到的一个技巧:它永远不会在正常处理中执行,因为该Resume <label>语句会将执行发送到其他地方.不过,它可能是调试的天赐之物.当您收到错误通知时,选择Debug(或按Ctl-Break,然后在"执行被中断"消息时选择Debug).下一个(突出显示的)语句将是MsgBox或以下语句.使用"设置下一个语句"(Ctl-F9)突出显示裸Resume,然后按F8.这将显示错误抛出的确切位置.

至于你反对这种格式"跳转",A)这是VBA程序员所期望的,如前所述,&B)你的惯例应该足够短,以至于跳得不远.

Answer 2

错误处理的两个主要目的:

1. 您可以预测但无法控制用户操作的陷阱错误(例如,在移除拇指驱动器时将文件保存到拇指驱动器)
2. 对于意外错误,请向用户显示一个表单,告知他们问题所在.这样,他们就可以将这条消息转发给您,您可以在修复工作时给他们一个解决方法.

那么,你会怎么做？

首先,创建一个错误表单,以便在发生意外错误时显示.

它可能看起来像这样(仅供参考:Mine被称为frmErrors):

请注意以下标签:

• lblHeadline
• lblSource
• lblProblem
• lblResponse

此外,标准命令按钮:

• 忽视
• 重试
• 取消

这种形式的代码没什么了不起的:

Option Explicit

Private Sub cmdCancel_Click()
  Me.Tag = CMD_CANCEL
  Me.Hide
End Sub

Private Sub cmdIgnore_Click()
  Me.Tag = CMD_IGNORE
  Me.Hide
End Sub

Private Sub cmdRetry_Click()
  Me.Tag = CMD_RETRY
  Me.Hide
End Sub

Private Sub UserForm_Initialize()
  Me.lblErrorTitle.Caption = "Custom Error Title Caption String"
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  'Prevent user from closing with the Close box in the title bar.
    If CloseMode <> 1 Then
      cmdCancel_Click
    End If
End Sub

基本上,您想知道用户在表单关闭时按下了哪个按钮.

接下来,创建一个将在整个VBA应用程序中使用的错误处理程序模块:

'****************************************************************
'    MODULE: ErrorHandler
'
'   PURPOSE: A VBA Error Handling routine to handle
'             any unexpected errors
'
'     Date:    Name:           Description:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'03/22/2010    Ray      Initial Creation
'****************************************************************
Option Explicit

Global Const CMD_RETRY = 0
Global Const CMD_IGNORE = 1
Global Const CMD_CANCEL = 2
Global Const CMD_CONTINUE = 3

Type ErrorType
    iErrNum As Long
    sHeadline As String
    sProblemMsg As String
    sResponseMsg As String
    sErrorSource As String
    sErrorDescription As String
    iBtnCap(3) As Integer
    iBitmap As Integer
End Type

Global gEStruc As ErrorType
Sub EmptyErrStruc_S(utEStruc As ErrorType)
  Dim i As Integer

  utEStruc.iErrNum = 0
  utEStruc.sHeadline = ""
  utEStruc.sProblemMsg = ""
  utEStruc.sResponseMsg = ""
  utEStruc.sErrorSource = ""
  For i = 0 To 2
    utEStruc.iBtnCap(i) = -1
  Next
  utEStruc.iBitmap = 1

End Sub
Function FillErrorStruct_F(EStruc As ErrorType) As Boolean
  'Must save error text before starting new error handler
  'in case we need it later
  EStruc.sProblemMsg = Error(EStruc.iErrNum)
  On Error GoTo vbDefaultFill

  EStruc.sHeadline = "Error " & Format$(EStruc.iErrNum)
  EStruc.sProblemMsg = EStruc.sErrorDescription
  EStruc.sErrorSource = EStruc.sErrorSource
  EStruc.sResponseMsg = "Contact the Company and tell them you received Error # " & Str$(EStruc.iErrNum) & ". You should write down the program function you were using, the record you were working with, and what you were doing."

   Select Case EStruc.iErrNum
       'Case Error number here
       'not sure what numeric errors user will ecounter, but can be implemented here
       'e.g.
       'EStruc.sHeadline = "Error 3265"
       'EStruc.sResponseMsg = "Contact tech support. Tell them what you were doing in the program."

     Case Else

       EStruc.sHeadline = "Error " & Format$(EStruc.iErrNum) & ": " & EStruc.sErrorDescription
       EStruc.sProblemMsg = EStruc.sErrorDescription

   End Select

   GoTo FillStrucEnd

vbDefaultFill:

  'Error Not on file
  EStruc.sHeadline = "Error " & Format$(EStruc.iErrNum) & ": Contact Tech Support"
  EStruc.sResponseMsg = "Contact the Company and tell them you received Error # " & Str$(EStruc.iErrNum)
FillStrucEnd:

  Exit Function

End Function
Function iErrorHandler_F(utEStruc As ErrorType) As Integer
  Static sCaption(3) As String
  Dim i As Integer
  Dim iMCursor As Integer

  Beep

  'Setup static array
  If Len(sCaption(0)) < 1 Then
    sCaption(CMD_IGNORE) = "&Ignore"
    sCaption(CMD_RETRY) = "&Retry"
    sCaption(CMD_CANCEL) = "&Cancel"
    sCaption(CMD_CONTINUE) = "Continue"
  End If

  Load frmErrors

  'Did caller pass error info?  If not fill struc with the needed info
  If Len(utEStruc.sHeadline) < 1 Then
    i = FillErrorStruct_F(utEStruc)
  End If

  frmErrors!lblHeadline.Caption = utEStruc.sHeadline
  frmErrors!lblProblem.Caption = utEStruc.sProblemMsg
  frmErrors!lblSource.Caption = utEStruc.sErrorSource
  frmErrors!lblResponse.Caption = utEStruc.sResponseMsg

  frmErrors.Show
  iErrorHandler_F = frmErrors.Tag   ' Save user response
  Unload frmErrors                  ' Unload and release form

  EmptyErrStruc_S utEStruc          ' Release memory

End Function

您可能会遇到仅针对您的应用程序自定义的错误.这通常只是一个错误的错误列表,特别是仅适用于您的应用程序.如果您还没有常量模块,请创建一个包含自定义错误的ENUM的模块.(注意:Office '97不支持ENUMS.).ENUM看起来像这样:

Public Enum CustomErrorName
  MaskedFilterNotSupported
  InvalidMonthNumber
End Enum

创建一个会抛出自定义错误的模块.

'********************************************************************************************************************************
'    MODULE: CustomErrorList
'
'   PURPOSE: For trapping custom errors applicable to this application
'
'INSTRUCTIONS:  To use this module to create your own custom error:
'               1.  Add the Name of the Error to the CustomErrorName Enum
'               2.  Add a Case Statement to the raiseCustomError Sub
'               3.  Call the raiseCustomError Sub in the routine you may see the custom error
'               4.  Make sure the routine you call the raiseCustomError has error handling in it
'
'
'     Date:    Name:           Description:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'03/26/2010    Ray       Initial Creation
'********************************************************************************************************************************
Option Explicit
Const MICROSOFT_OFFSET = 512 'Microsoft reserves error values between vbObjectError and vbObjectError + 512
'************************************************************************************************
'  FUNCTION:  raiseCustomError
'
'   PURPOSE:  Raises a custom error based on the information passed
'
'PARAMETERS:  customError - An integer of type CustomErrorName Enum that defines the custom error
'             errorSource - The place the error came from
'
'   Returns:  The ASCII vaule that should be used for the Keypress
'
'     Date:    Name:           Description:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'03/26/2010    Ray       Initial Creation
'************************************************************************************************
Public Sub raiseCustomError(customError As Integer, Optional errorSource As String = "")
  Dim errorLong As Long
  Dim errorDescription As String

  errorLong = vbObjectError + MICROSOFT_OFFSET + customError

  Select Case customError

    Case CustomErrorName.MaskedFilterNotSupported
      errorDescription = "The mask filter passed is not supported"

    Case CustomErrorName.InvalidMonthNumber
      errorDescription = "Invalid Month Number Passed"

    Case Else
      errorDescription = "The custom error raised is unknown."

  End Select

  Err.Raise errorLong, errorSource, errorDescription

End Sub

您现在已经准备好在程序中捕获错误.你sub(或函数),应该看起来像这样:

Public Sub MySub(monthNumber as Integer)
  On Error GoTo eh  

  Dim sheetWorkSheet As Worksheet

  'Run Some code here

  '************************************************
  '*   OPTIONAL BLOCK 1:  Look for a specific error
  '************************************************
  'Temporarily Turn off Error Handling so that you can check for specific error
  On Error Resume Next
  'Do some code where you might expect an error.  Example below:
  Const ERR_SHEET_NOT_FOUND = 9 'This error number is actually subscript out of range, but for this example means the worksheet was not found

  Set sheetWorkSheet = Sheets("January")

  'Now see if the expected error exists

  If Err.Number = ERR_SHEET_NOT_FOUND Then
    MsgBox "Hey!  The January worksheet is missing.  You need to recreate it."
    Exit Sub
  ElseIf Err.Number <> 0 Then
    'Uh oh...there was an error we did not expect so just run basic error handling 
    GoTo eh
  End If

  'Finished with predictable errors, turn basic error handling back on:
  On Error GoTo eh

  '**********************************************************************************
  '*   End of OPTIONAL BLOCK 1
  '**********************************************************************************

  '**********************************************************************************
  '*   OPTIONAL BLOCK 2:  Raise (a.k.a. "Throw") a Custom Error if applicable
  '**********************************************************************************
  If not (monthNumber >=1 and monthnumber <=12) then
    raiseCustomError CustomErrorName.InvalidMonthNumber, "My Sub"
  end if
  '**********************************************************************************
  '*   End of OPTIONAL BLOCK 2
  '**********************************************************************************

  'Rest of code in your sub

  goto sub_exit

eh:
  gEStruc.iErrNum = Err.Number
  gEStruc.sErrorDescription = Err.Description
  gEStruc.sErrorSource = Err.Source
  m_rc = iErrorHandler_F(gEStruc)

  If m_rc = CMD_RETRY Then
    Resume
  End If

sub_exit:
  'Any final processing you want to do.
  'Be careful with what you put here because if it errors out, the error rolls up.  This can be difficult to debug; especially if calling routine has no error handling.

  Exit Sub 'I was told a long time ago (10+ years) that exit sub was better than end sub...I can't tell you why, so you may not want to put in this line of code.  It's habit I can't break :P
End Sub

上面代码的复制/粘贴可能无法正常工作,但绝对应该给你一个要点.

顺便说一句,如果您需要我做您的公司徽标,请查看http://www.MySuperCrappyLogoLabels99.com

Answer 3

我肯定不会使用Block1.在与错误无关的IF语句中出现错误块似乎不正确.

块2,3和4我猜是主题的变体.由于不喜欢GOTO声明,我更喜欢使用Block 3和4而不是2; 我通常使用Block4方法.这是我用来检查是否添加了Microsoft ActiveX Data Objects 2.8库以及是否添加或使用早期版本(如果2.8不可用)的代码的一个示例.

Option Explicit
Public booRefAdded As Boolean 'one time check for references

Public Sub Add_References()
Dim lngDLLmsadoFIND As Long

If Not booRefAdded Then
    lngDLLmsadoFIND = 28 ' load msado28.tlb, if cannot find step down versions until found

        On Error GoTo RefErr:
            'Add Microsoft ActiveX Data Objects 2.8
            Application.VBE.ActiveVBProject.references.AddFromFile _
            Environ("CommonProgramFiles") + "\System\ado\msado" & lngDLLmsadoFIND & ".tlb"

        On Error GoTo 0

    Exit Sub

RefErr:
        Select Case Err.Number
            Case 0
                'no error
            Case 1004
                 'Enable Trust Centre Settings
                 MsgBox ("Certain VBA References are not available, to allow access follow these steps" & Chr(10) & _
                 "Goto Excel Options/Trust Centre/Trust Centre Security/Macro Settings" & Chr(10) & _
                 "1. Tick - 'Disable all macros with notification'" & Chr(10) & _
                 "2. Tick - 'Trust access to the VBA project objects model'")
                 End
            Case 32813
                 'Err.Number 32813 means reference already added
            Case 48
                 'Reference doesn't exist
                 If lngDLLmsadoFIND = 0 Then
                    MsgBox ("Cannot Find Required Reference")
                    End
                Else
                    For lngDLLmsadoFIND = lngDLLmsadoFIND - 1 To 0 Step -1
                           Resume
                    Next lngDLLmsadoFIND
                End If

            Case Else
                 MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
                End
        End Select

        On Error GoTo 0
End If
booRefAdded = TRUE
End Sub

Answer 4

我保持简单:
在模块级别,我定义了两个变量,并将一个变量设置为模块本身的名称.

    Private Const ThisModuleName            As String = "mod_Custom_Functions"
    Public sLocalErrorMsg                   As String

在模块的每个Sub/Function中,我定义了一个局部变量

    Dim ThisRoutineName                     As String

我将ThisRoutineName设置为子或函数的名称

' Housekeeping
    On Error Goto ERR_RTN
    ThisRoutineName = "CopyWorksheet"

然后我将所有错误发送到ERR_RTN:当它们发生时,我首先设置sLocalErrorMsg来定义错误实际是什么并提供一些调试信息.

    If Len(Trim(FromWorksheetName)) < 1 Then
        sLocalErrorMsg = "Parameter 'FromWorksheetName' Is Missing."
        GoTo ERR_RTN
    End If

在每个子/函数的底部,我指导逻辑流程如下

    '
    ' The "normal" logic goes here for what the routine does
    '
    GoTo EXIT_RTN

    ERR_RTN:

        On Error Resume Next

    ' Call error handler if we went this far.
        ErrorHandler ThisModuleName, ThisRoutineName, sLocalErrorMsg, Err.Description, Err.Number, False

    EXIT_RTN:

        On Error Resume Next
     '
     ' Some closing logic
     '
    End If

然后我有一个单独的模块,我把它放在所有名为"mod_Error_Handler"的项目中.

    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Subroutine Name:     ErrorHandler                                                     '
    '                                                                                       '
    ' Description:                                                                          '
    '   This module will handle the common error alerts.                                    '
    '                                                                                       '
    ' Inputs:                                                                               '
    '   ModuleName                String    'The name of the module error is in.            '
    '   RoutineName               String    'The name of the routine error in in.           '
    '   LocalErrorMsg             String    'A local message to assist with troubleshooting.'
    '   ERRDescription            String    'The Windows Error Description.                 '
    '   ERRCode                   Long      'The Windows Error Code.                        '
    '   Terminate                 Boolean   'End program if error encountered?              '
    '                                                                                       '
    ' Revision History:                                                                     '
    ' Date (YYYYMMDD) Author                Change                                          '
    ' =============== ===================== =============================================== '
    ' 20140529        XXXXX X. XXXXX        Original                                        '
    '                                                                                       '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '
    Public Sub ErrorHandler(ModuleName As String, RoutineName As String, LocalErrorMsg As String, ERRDescription As String, ERRCode As Long, Terminate As Boolean)
        Dim sBuildErrorMsg                 As String

    ' Build Error Message To Display
        sBuildErrorMsg = "Error Information:" & vbCrLf & vbCrLf

        If Len(Trim(ModuleName)) < 1 Then
            ModuleName = "Unknown"
        End If

        If Len(Trim(RoutineName)) < 1 Then
           RoutineName = "Unknown"
        End If

        sBuildErrorMsg = sBuildErrorMsg & "Module Name:        " & ModuleName & vbCrLf & vbCrLf
        sBuildErrorMsg = sBuildErrorMsg & "Routine Name:       " & RoutineName & vbCrLf & vbCrLf

        If Len(Trim(LocalErrorMsg)) > 0 Then
            sBuildErrorMsg = sBuildErrorMsg & "Local Error Msg:    " & LocalErrorMsg & vbCrLf & vbCrLf
        End If

        If Len(Trim(ERRDescription)) > 0 Then
            sBuildErrorMsg = sBuildErrorMsg & "Program Error Msg:  " & ERRDescription & vbCrLf & vbCrLf
            If IsNumeric(ERRCode) Then
                sBuildErrorMsg = sBuildErrorMsg & "Program Error Code: " & Trim(Str(ERRCode)) & vbCrLf & vbCrLf
            End If
        End If

        MsgBox sBuildErrorMsg, vbOKOnly + vbExclamation, "Error Detected!"

        If Terminate Then
            End
        End If

    End Sub

最终的结果是弹出错误消息,告诉我什么模块,什么是soubroutine,以及错误消息具体是什么.此外,它还将插入Windows错误消息和代码.