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

Check the error number

   <source lang="vb">

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

</source>
   
  

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

   <source lang="vb">

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

</source>
   
  

Creating a User-Defined Error

   <source lang="vb">

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

</source>
   
  

Deal with the error

   <source lang="vb">

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

</source>
   
  

Get the Error source

   <source lang="vb">

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

</source>
   
  

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

   <source lang="vb">

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

</source>
   
  

Properties of the Err Object

   <source lang="vb">

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

</source>
   
  

Raising an Error

   <source lang="vb">

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

</source>
   
  

RunTime Error ethod Range of Object Global Failed

   <source lang="vb">

Sub SetReportInItalics()

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

End Sub

</source>
   
  

Runtime Error 9: Subscript Out of Range

   <source lang="vb">

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

</source>
   
  

Show Error discription in MsgBox

   <source lang="vb">

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

</source>
   
  

Show Error Number

   <source lang="vb">

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

</source>
   
  

The Mail your Error Routine

   <source lang="vb">

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

</source>
   
  

Trap the error with On Error GoTo

   <source lang="vb">

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

</source>
   
  

Try again in case an error

   <source lang="vb">

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

</source>
   
  

Using the LogError Routine

   <source lang="vb">

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

</source>
   
  

Viewing the Errors Stored in the Errors Collection

   <source lang="vb">

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

</source>
   
  

Writing Information to a Textual Error Log File

   <source lang="vb">

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

</source>