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

Материал из VB Эксперт
Перейти к: навигация, поиск

An Example of Code Without Error Handling

   <source lang="vb">

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

</source>
   
  


An Example of Error Handling Using the On Error GoTo Statement

   <source lang="vb">

Sub SimpleErrorHandler()

   On Error GoTo SimpleErrorHandler_Err
   Dim sngResult As Single
   sngResult = 1 / 0
   Exit Sub

SimpleErrorHandler_Err:

   msgBox "Oops!"
   Exit Sub

End Sub

</source>
   
  


A Simple Error-Handling Routine

   <source lang="vb">

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

</source>
   
  


EBEngine.Errors

   <source lang="vb">

  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
</source>
   
  


error handling by checking the Error code

   <source lang="vb">

    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
</source>
   
  


Ignoring an Error and Continuing Execution

   <source lang="vb">

Sub TestResumeNext()

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

End Sub

</source>
   
  


Looking Up the Call Stack for a Previous Error Handler

   <source lang="vb">

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

</source>
   
  


Placing a Resume Next Statement in Your Error Handler

   <source lang="vb">

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

</source>
   
  


Read user choice when dealing with error

   <source lang="vb">

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

</source>
   
  


Using Resume Conditionally Based on User Feedback

   <source lang="vb">

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

</source>
   
  


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

   <source lang="vb">

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

</source>