Abdul-
You can create your own list in a table. You need a table called ErrTable that
has two fields:
ErrorCode Number, Long Integer
ErrorString Memo
(You actually don't need the table in advance because the code below will create
it if it doesn't exist.)
Then run this code:
--------------------------------------------------------
Function CreateErrTable()
' This function creates a table containing a list of all the valid
' Access application error codes
' You can find the ADO version of this procedure in Contacts.accdb
' Declare variables used in this function
Dim dbMyDatabase As DAO.Database, tblErrTable As DAO.TableDef, _
fldMyField As DAO.Field, idxPKey As DAO.Index
Dim rcdErrRecSet As DAO.Recordset, lngErrCode As Long, intMsgRtn As Integer
Dim varReturnVal As Variant, varErrString As Variant, ws As DAO.Workspace
' Create Errors table with Error Code and Error String fields.
' Initialize the MyDatabase database variable to the current database
Set dbMyDatabase = CurrentDb
Set ws = DBEngine.Workspaces(0)
' Trap error if table doesn't exist
On Error Resume Next ' Skip to next statement if an error occurs
Set rcdErrRecSet = dbMyDatabase.OpenRecordset("ErrTable")
Select Case Err ' See if an error was raised
Case 0 ' No error - table must alread exist
On Error GoTo 0 ' Turn off error trapping
intMsgRtn = MsgBox("ErrTable already exists. Do you want to " & _
"delete and rebuild all rows?", vbQuestion + vbYesNo, "Access
2003 Inside Out")
If intMsgRtn = vbYes Then ' Reply was YES - delete rows and
rebuild
' Run quick SQL to delete rows
dbMyDatabase.Execute "Delete * From ErrTable;", dbFailOnError
Else ' Reply was NO - done
rcdErrRecSet.Close ' Close the table
Exit Function ' And exit
End If
Case 3011, 3078 ' Couldn't find table, so build it
On Error GoTo 0 ' Turn off error trapping
' Create a new table to contain the error rows
Set tblErrTable = dbMyDatabase.CreateTableDef("ErrTable")
' Create a field in ErrTable to contain the error code
Set fldMyField = tblErrTable.CreateField("ErrorCode", DB_LONG)
' Append the "ErrorCode" field to the fields collection in
' the new table definition
tblErrTable.Fields.Append fldMyField
' Create a field in ErrTable to contain the error description
Set fldMyField = tblErrTable.CreateField("ErrorString", DB_MEMO)
' Append the "ErrorString" field to the fields collection in
' the new table definition
tblErrTable.Fields.Append fldMyField
' Append the new table to the TableDefs collection in
' the current database
dbMyDatabase.TableDefs.Append tblErrTable
' Set text field width to 5" (7200 twips) (calls Sub procedure)
SetFieldProperty tblErrTable![ErrorString], "ColumnWidth",
DB_INTEGER, 7200
' Create a Primary Key
Set idxPKey = tblErrTable.CreateIndex("PrimaryKey")
' Create and append the field to the index fields collection
idxPKey.Fields.Append idxPKey.CreateField("ErrorCode")
' Make it the Primary Key
idxPKey.Primary = True
' Create the index
tblErrTable.Indexes.Append idxPKey
' Set recordset to Errors Table recordset.
Set rcdErrRecSet = dbMyDatabase.OpenRecordset("ErrTable")
Case Else ' Can't identify the error - write message and bail
MsgBox "Unknown error in CreateErrTable " & Err & ", " &
Error$(Err), vbExclamation
Exit Function
End Select
'Initialize the progress meter on the status bar
varReturnVal = SysCmd(acSysCmdInitMeter, "Building Error Table", 32767)
' Turn on hourglass to show this may take a while
DoCmd.Hourglass True
' Start a transaction to make it go fast
ws.BeginTrans
' Loop through Microsoft Access error codes, skipping error codes
' that generate "User-defined error" or "Reserved Error" message.
For lngErrCode = 1 To 32767
varErrString = AccessError(lngErrCode)
If IsNothing(varErrString) Or varErrString = "Application-defined or
object-defined error" Then
' If AccessError returned nothing, then try Error
varErrString = Error(lngErrCode)
End If
If Not IsNothing(varErrString) Then
If varErrString <> "Application-defined or object-defined error" Then
' Add each error code and string to Errors table.
rcdErrRecSet.AddNew
rcdErrRecSet("ErrorCode") = lngErrCode
' Put the message text in the record
rcdErrRecSet("ErrorString") = varErrString
rcdErrRecSet.Update
End If
End If
' Update the status meter
varReturnVal = SysCmd(acSysCmdUpdateMeter, lngErrCode)
' Process next error code
Next lngErrCode
' Commit all added rows
ws.CommitTrans
' Close recordset.
rcdErrRecSet.Close
' Turn off the hourglass - we're done
DoCmd.Hourglass False
' And reset the status bar
varReturnVal = SysCmd(acSysCmdClearStatus)
' Select the new table in the database window to refresh the list
DoCmd.SelectObject acTable, "ErrTable", True
' pop up a confirmation dialog
MsgBox "Errors table created."
End Function
Public Function IsNothing(ByVal varValueToTest) As Integer
'----------------------------------------------------------
' Does a "nothing" test based on data type.
' Null = nothing
' Empty = nothing
' Number = 0 is nothing
' String = "" is nothing
' Date/Time is never nothing
' Inputs: A value to test for logical "nothing"
' Outputs: True = value passed is a logical "nothing", False = it ain't
' Created By: JLV 01/31/95
' Last Revised: JLV 01/31/95
'----------------------------------------------------------
Dim intSuccess As Integer
On Error GoTo IsNothing_Err
IsNothing = True
Select Case VarType(varValueToTest)
Case 0 ' Empty
GoTo IsNothing_Exit
Case 1 ' Null
GoTo IsNothing_Exit
Case 2, 3, 4, 5, 6 ' Integer, Long, Single, Double, Currency
If varValueToTest <> 0 Then IsNothing = False
Case 7 ' Date / Time
IsNothing = False
Case 8 ' String
If (Len(varValueToTest) <> 0 And varValueToTest <> " ") Then
IsNothing = False
End Select
IsNothing_Exit:
On Error GoTo 0
Exit Function
IsNothing_Err:
IsNothing = True
Resume IsNothing_Exit
End Function
--------------------------------------------------
John Viescas, author
Microsoft Office Access 2010 Inside Out
Microsoft Office Access 2007 Inside Out
Building Microsoft Access Applications
Microsoft Office Access 2003 Inside Out
SQL Queries for Mere Mortals
http://www.viescas.com/
(Paris, France)
-----Original Message-----
From: MS_Access_Professionals@yahoogroups.com
[mailto:MS_Access_Professionals@yahoogroups.com] On Behalf Of Abdul Shakeel
Sent: Sunday, May 29, 2011 1:07 PM
To: MS_Access_Professionals@yahoogroups.com
Subject: [MS_AccessPros] Access Errors
Hi All,
where can I find complete details about access errors with there code &
descriptions.
Thanks & Regards,
--
Abdul Shakeel
[Non-text portions of this message have been removed]
------------------------------------
Yahoo! Groups Links
Tidak ada komentar:
Posting Komentar