VBA/Excel/Access/Word/Language Basics/Error Handler

An Example of Code Without Error Handling

 
Sub cmdNoErrorHandler()
    Call TestError1(1, 0)
End Sub
Sub TestError1(Numerator As Integer, Denominator As Integer)
    Debug.Print Numerator / Denominator
    msgBox "I am in Test Error"
End Sub

An Example of Error Handling Using the On Error GoTo Statement

 
Sub SimpleErrorHandler()
    On Error GoTo SimpleErrorHandler_Err
    Dim sngResult As Single
    sngResult = 1 / 0
    Exit Sub
SimpleErrorHandler_Err:
    msgBox "Oops!"
    Exit Sub
End Sub

A Simple Error-Handling Routine

 
Sub TestError2()
On Error GoTo TestError2_Err
    Debug.Print 1 / 0
    msgBox "I am in Test Error"
    Exit Sub
TestError2_Err:
    If Err = 11 Then
        msgBox "Variable 2 Cannot Be a Zero", , "Custom Error Handler"
    End If
    Exit Sub
End Sub

EBEngine.Errors

 
   Public Sub ShowErrors()
      Dim db   As Database
      Dim recT As Recordset
      Dim errE As Error
   
      On Error GoTo ShowErrors_Err
   
      Set db = CurrentDb()
       Set recT = db.OpenRecordset("NonExistantTable")
       recT.Close
    
ShowErrors_Exit:
       Exit Sub
    
ShowErrors_Err:
       Debug.Print "Err = " & Err.Number & ": " & Err.Description
       Debug.Print
    
       For Each errE In DBEngine.Errors
          Debug.Print "Errors: " & errE.Number & ": " & errE.Description
       Next
       Resume ShowErrors_Exit
    
    End Sub

error handling by checking the Error code

 
     Public Sub ErrorHandling()
        On Error GoTo ErrorHandling_Err
        Dim dblResult As Double
        dblResult = 10 / InputBox("Enter a number:")
        MsgBox "The result is " & dblResult
ErrorHandling_Exit:
        Exit Sub
ErrorHandling_Err:
        Select Case Err.Number
        Case 13         " Type mismatch - empty entry
           Resume
        Case 11         " Division by 0
           dblResult = 0
           Resume Next
        Case Else
           MsgBox "Oops: " & Err.Description & " - " & Err.Number
           Resume ErrorHandling_Exit
        End Select
     End Sub

Ignoring an Error and Continuing Execution

 
Sub TestResumeNext()
    On Error Resume Next
    Kill "AnyFile"
    If Err.number = 0 Then
    Else
        MsgBox "the Error Was: " & Err.Description
    End If
End Sub

Looking Up the Call Stack for a Previous Error Handler

 
Sub Func1()
    On Error GoTo Func1_Err
    Debug.Print "I am in Function 1"
    Call Func2
    Debug.Print "I am back in Function 1"
    Exit Sub
Func1_Err:
    msgBox "Error in Func1"
    Resume Next
End Sub
Sub Func2()
    Debug.Print "I am in Func2"
    Call Func3
    Debug.Print "I am still in Func2"
End Sub
Sub Func3()
    Dim sngAnswer As Single
    Debug.Print "I am in Func3"
    sngAnswer = 5 / 0
    Debug.Print "I am still in Func3"
End Sub

Placing a Resume Next Statement in Your Error Handler

 
Sub TestResumeNextInError()
    On Error GoTo TestResumeNextInError_Err
    Kill "AnyFile"
    If Err.number = 0 Then
    Else
        msgBox "We Didn"t Die, But the Error Was: " & Err.Description
    End If
    Exit Sub
TestResumeNextInError_Err:
    Resume Next
End Sub

Read user choice when dealing with error

 
Public Sub ErrorTrap1()
  Dim Answer As Long, MyFile As String
  Dim Message As String, CurrentPath As String
  
  On Error GoTo errTrap
  CurrentPath = CurDir$
  
  ChDrive "A"
  ChDrive CurrentPath
  ChDir CurrentPath
  MyFile = "A:\Data.xls"
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs Filename:=MyFile
TidyUp:
  ChDrive CurrentPath
  ChDir CurrentPath
Exit Sub
errTrap:
  Message = "Error No: = " & Err.Number & vbCr
  Message = Message & Err.Description & vbCr & vbCr
  Message = Message & "Please place a disk in the A: drive" & vbCr
  Message = Message & "and press OK" & vbCr & vbCr
  Message = Message & "Or press Cancel to abort File Save"
  Answer = MsgBox(Message, vbQuestion + vbOKCancel, "Error")
  If Answer = vbCancel Then Resume TidyUp
  Resume
End Sub

Using Resume Conditionally Based on User Feedback

 
Function GoodResume()
    On Error GoTo GoodResume_Err
    Dim strFile As String
    strFile = Dir(strFileName)
    If strFile = "" Then
      GoodResume = False
    Else
      GoodResume = True
    End If
    Exit Function
GoodResume_Err:
    Dim intAnswer As Integer
    intAnswer = MsgBox(Error & ", Would You Like to Try Again?", vbYesNo)
    If intAnswer = vbYes Then
        Resume
    Else
        Exit Function
    End If
End Function

Using the Resume <LineLabel> Statement to Specify Where Execution Continues After an Error Occurs

 
Sub TestResumeLineLabel()
    On Error GoTo TestResumeLineLabel_Err
    Dim sngResult As Single
    sngResult = 1 / 0
TestResumeLineLabel_Exit:
    Exit Sub
TestResumeLineLabel_Err:
    msgBox "Error #" & Err.number & ": " & Err.Description
    Resume TestResumeLineLabel_Exit
End Sub