Хорошие шаблоны для обработки ошибок VBA
Каковы некоторые хорошие шаблоны для обработки ошибок в 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) ...
Я хочу, чтобы обрабатывать ошибки, и возобновить выполнение после кода, где может возникнуть ошибка. Кроме того, код finally в конце всегда должен выполняться - независимо от того, какие исключения были созданы ранее. Как я могу достичь такого результата?
12 ответов:
обработка ошибок в VBA
On Error Goto
ErrorHandlerLabelResume
(Next
/ErrorHandlerLabel)On Error Goto 0
(отключает текущий обработчик ошибок)Err
объектThe
Err
свойства объекта обычно сбрасываются в ноль или строку нулевой длины в процедуре обработки ошибок, но это также может быть сделано явно с помощьюErr.Clear
.ошибки в процедуре обработки ошибок завершаются.
диапазон 513-65535 доступен для ошибок пользователя. Для пользовательских ошибок класса, вы добавляете
vbObjectError
с номером ошибки. См. документацию MS оErr.Raise
и список номеров ошибок.для не реализованных элементов интерфейса в производные класс, вы должны использовать константу
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
Я бы еще добавил:
- глобальные
Err
объект является самым близким к объекту исключения- вы можете эффективно "бросить исключение" с
Err.Raise
и просто для удовольствия:
On Error Resume Next
является ли дьявол воплощенным и его следует избегать, так как он молча скрывает ошибки
Так что вы могли бы сделать что-то подобное
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 для изменения потока метода по мере необходимости.
вот моя стандартная реализация. Мне нравится, чтобы ярлыки были самоописательными.
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
Профессиональная Разработка Excel очень хорошо схема обработки ошибок. Если вы собираетесь провести какое-то время в VBA, наверное, стоит книга. Есть ряд областей, где VBA отсутствует, и в этой книге есть хорошие предложения по управлению этими областями.
PED описывает два метода обработки ошибок. Главным из них является система, в которой все процедуры точки входа являются подпроцедурами, а все остальные процедуры являются функциями, которые возвращают Логические значения.
процедура точки входа используется в операторах ошибок для захвата ошибок в значительной степени, как и было задумано. Процедуры точки входа возвращают True, если ошибок не было, и False, если были ошибки. Процедуры точки не-входа также используют на ошибке.
оба типа процедур используют центральную процедуру обработки ошибок для сохранения ошибки в состоянии и регистрации ошибки.
вот довольно приличная картина.
для отладки: Когда возникает ошибка, нажмите Ctrl-Break (или Ctrl-Pause), перетащите маркер разрыва (или как он называется) вниз к строке возобновления, нажмите 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
Я использую кусок кода, который я разработал сам, и это очень хорошо для мой код:
в начале функции или Sub, я определяю:
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
мой личный взгляд на заявление, сделанное ранее в этой теме:
и просто для удовольствия:
по ошибке резюме далее является воплощением дьявола и следует избегать, так как он молча скрывает ошибки.
Я использую
On Error Resume Next
на процедурах, где я не хочу, чтобы ошибка останавливала мою работу и где любой оператор не зависит от результата предыдущих операторов.когда я делаю это, я добавляю глобальную переменную
debugModeOn
и я установите его вTrue
. Тогда я использую его таким образом:If not debugModeOn Then On Error Resume Next
когда я выполняю свою работу, я устанавливаю переменную в false, тем самым скрывая ошибки только для пользователя и показывая их во время тестирования.
также использовать его при выполнении чего-то, что может не сработать, как вызов DataBodyRange объекта ListObject, который может быть пустым:
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)
код ниже показывает альтернативу, которая гарантирует, что есть только одна точка выхода для sub/функции.
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
Я считаю, что лучше всего работает следующее, называемое центральным подходом к обработке ошибок.
преимущества
у вас есть 2 режима работы приложения: Debug и производства. В Debug режим, код остановится при любой неожиданной ошибке и позволит вам легко отлаживать, перейдя к строке, где это произошло, дважды нажав 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
установить в Debug режим, выполните следующие действия в окне немедленное:
SetDebugMode True