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

Check the error number

 
Sub errorTest1()
    Dim intNumerator As Integer
    Dim intDenominator As Integer
    Dim intResult As Double
    On Error GoTo mytrap
    intNumerator = InputBox("Please enter a numerator", "Numerator")
enterDenominator:
    intDenominator = InputBox("Please enter a denominator", "Denominator")
    intResult = intNumerator / intDenominator
    msgBox "The result is " & intResult
    Exit Sub
mytrap:
    If Err.number = 11 Then
       msgBox ("The description of the error is " & Err.Description)
    Else
       msgBox ("Something else is going wrong")
    End If
    Resume enterDenominator
End Sub

Create an error, and then query the object for the error number and description

 
Sub errorTest0()
    Dim intNumerator As Integer
    Dim intDenominator As Integer
    Dim intResult As Double
On Error GoTo mytrap
   intNumerator = InputBox("Please enter a numerator", "Numerator")
enterDenominator:
   intDenominator = InputBox("Please enter a denominator", "Denominator")
   intResult = intNumerator / intDenominator
   msgBox "The result is " & intResult
   Exit Sub
mytrap:
    msgBox "The number of this error is " & Err.number
    msgBox "The description of the error is " & Err.Description
    Resume enterDenominator
End Sub

Creating a User-Defined Error

 
Sub TestCustomError()
   On Error GoTo TestCustomError_Err
   Dim strName As String
   strName = "aa"
   If Len(strName) < 5 Then
      Err.Raise number:=11111, _
               Description:="Length of Name is Too Short"
   Else
     msgBox "You Entered " & strName
   End If
   Exit Sub
TestCustomError_Err:
    "Display a message with the error number
    "and description
    msgBox "Error # " & Err.number & _
        " - " & Err.Description
    Exit Sub
End Sub

Deal with the error

 
Sub errorTest()
    Dim intNumerator As Integer
    Dim intDenominator As Integer
    Dim intResult As Integer
On Error GoTo mytrap
    intNumerator = 1
    intDenominator = 0
    intResult = intNumerator / intDenominator
    msgBox ("The result is " & intResult)
    Exit Sub
mytrap:
    msgBox "You cannot divide by zero"
End Sub

Get the Error source

 
Sub errorTest2()
    Dim intNumerator As Integer
    Dim intDenominator As Integer
    Dim intResult As Double
    On Error GoTo mytrap
    intNumerator = InputBox("Please enter a numerator", "Numerator")
enterDenominator:
    intDenominator = InputBox("Please enter a denominator", "Denominator")
    intResult = intNumerator / intDenominator
    msgBox "The result is " & intResult
    Exit Sub
mytrap:
    If Err.number = 11 Then
       msgBox (Err.Source)
    Else
       msgBox ("Something else is going wrong")
    End If
    Resume enterDenominator
End Sub

Move through the Errors collection and display properties of each Error object

 
Public Sub errorTest3()
    Dim myConn As ADODB.Connection
    Dim myErr As ADODB.Error
    Dim strError As String
    On Error GoTo myHandler
    " Intentionally trigger an error
    Set myConn = New ADODB.Connection
    myConn.Open "nothing"
    Set myConn = Nothing
    Exit Sub
myHandler:
    For Each myErr In myConn.Errors
        strError = "Error #" & Err.number & vbCr & _
            "   " & myErr.Description & vbCr & _
            "   (Source: " & myErr.Source & ")" & vbCr & _
            "   (SQL State: " & myErr.SQLState & ")" & vbCr & _
            "   (NativeError: " & myErr.NativeError & ")" & vbCr
        If myErr.HelpFile = "" Then
            strError = strError & "   No Help file available"
        Else
            strError = strError & _
               "   (HelpFile: " & myErr.HelpFile & ")" & vbCr & _
               "   (HelpContext: " & myErr.HelpContext & ")" & _
               vbCr & vbCr
        End If
        Debug.Print strError
    Next
    Resume Next
End Sub

Properties of the Err Object

 
Property        Description
Description     Description of the error that occurred
HelpContext     Context ID for the Help file
HelpFile        Path and filename of the Help file
LastDllError    Last error that occurred in a 32-bit dynamic link library (DLL)
Number          Number of the error that was set
Source          System in which the error occurred

Raising an Error

 
Sub TestRaiseError()
    On Error GoTo TestRaiseError_Err
    Dim sngResult As String
    Err.Raise 11
    Exit Sub
TestRaiseError_Err:
    msgBox "Error #" & Err.number & ": " & Err.Description
    Exit Sub
End Sub

RunTime Error ethod Range of Object Global Failed

 
Sub SetReportInItalics()
    TotalRow = cells(Rows.count, 1).End(xlUp).row
    FinalRow = TotalRow - 1
    range("A1:A" & FinalRow).font.Italic = True
End Sub

Runtime Error 9: Subscript Out of Range

 
Sub GetSettings()
    On Error Resume Next
    x = ThisWorkbook.Worksheets("Menu").name
    If Not Err.Number = 0 Then
        MsgBox "Expected to find a Menu worksheet, but it is missing"
        Exit Sub
    End If
    On Error GoTo 0
    ThisWorkbook.Worksheets("Menu").Select
    x = range("A1").value
End Sub

Show Error discription in MsgBox

 
Sub ErrorTrap2()
  Dim Answer As Long, MyFile As String
  Dim Message As String, currentPath As String
  
  On Error GoTo errTrap
  MyFile = "A:\Data.xls"
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs FileName:=MyFile
Exit Sub
errTrap:
  MsgBox Err.Description
End Sub

Show Error Number

 
Sub ErrorTrap2()
  Dim MyFile As String, Message As String
  Dim Answer As String
  
  On Error GoTo errTrap
  
  Workbooks.Add
  MyFile = "C:\Data.xls"
  Kill MyFile
  ActiveWorkbook.SaveAs FileName:=MyFile
  ActiveWorkbook.Close
 
  Exit Sub
errTrap:
  Message = "Error No: = " & Err.Number & vbCr
  Message = Message & Err.Description & vbCr & vbCr
  Message = Message & "File does not exist"
  Answer = MsgBox(Message, vbInformation, "Error")
  Resume Next
End Sub

The Mail your Error Routine

 
Sub MailError(strUserInfo As String, _
    strErrorInfo As String)
    Dim objCurrentMessage As Outlook.MailItem
    Dim objNamespace As Outlook.NameSpace
    Dim objMessage As Outlook.MAPIFolder
    Set objNamespace = GetOutlook()
    Set objMessage = objNamespace.GetDefaultFolder(olFolderOutbox)
    With objMessage.Items.Add(olMailItem)
        .To = "guru@somecompany.ru"
        .Subject = strUserInfo
        .Body = strErrorInfo
        .Save
    End With
End Sub

Trap the error with On Error GoTo

 
Sub ErrorTrap()
  Dim Answer As Long, MyFile As String
  Dim Message As String, currentPath As String
  
  On Error GoTo errTrap
  MyFile = "A:\Data.xls"
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs FileName:=MyFile
Exit Sub
errTrap:
  MsgBox "Error No: = " & Err.Number
End Sub

Try again in case an error

 
Sub TryAgain()
  Dim Value As Double
  On Error GoTo Except
  
    Value = CInt(InputBox("Enter a number:", "Number"))
    Value = 10 / Value
    MsgBox "10 / " & 10 * Value & "=" & Value
  
  Exit Sub
  
Except:
  If (MsgBox(Err.Description & ". Try again", vbYesNo, _
    "Try Again") = vbYes) Then TryAgain
End Sub

Using the LogError Routine

 
Sub LogError()
    Dim cnn As adodb.Connection
    Dim strSQL As String
    Set cnn = CurrentProject.Connection
    strSQL = "INSERT INTO tblErrorLog ( ErrorDate, ErrorTime, " & _
    "UserName, ErrorNum, ErrorString, ModuleName, RoutineName) "
    strSQL = strSQL & "Select #" & gtypError.datDateTime & "#, #" _
                              & gtypError.datDateTime & "#, "" _
                              & gtypError.strUserName & "", " _
                              & gtypError.lngErrorNum & ", "" _
                              & gtypError.strMessage & "", "" _
                              & gtypError.strModule & "", "" _
                              & gtypError.strRoutine & """
    "Execute the SQL statement
    cnn.Execute strSQL, , adExecuteNoRecords
End Sub

Viewing the Errors Stored in the Errors Collection

 
Sub TestErrorsCollection()
    On Error GoTo TestErrorsCollection_Err
    Dim db As DAO.Database
    Set db = CurrentDb
    db.Execute ("qryNonExistent")
    Exit Sub
TestErrorsCollection_Err:
    Dim ErrorDescrip As DAO.Error
    For Each ErrorDescrip In Errors
        Debug.Print ErrorDescrip.number
        Debug.Print ErrorDescrip.Description
    Next ErrorDescrip
    Exit Sub
End Sub

Writing Information to a Textual Error Log File

 
Sub LogErrorText()
    Dim intFile As Integer
    "Store a free file handle into a variable
    intFile = FreeFile
    "Open a file named ErrorLog.txt in the current directory
    "using the file handle obtained above
    Open CurDir & "\ErrorLog.Txt" For Append Shared As intFile
    "Write the error information to the file
    Write #intFile, "LogErrorDemo", Now, Err, Error, CurrentUser()
    "Close the file
    Close intFile
End Sub