в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:46:31Z

1 версия

Новая страница

==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>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Language Basics/Error - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия