Xuân Thanh > 27-08-20, 11:10 AM
Option Compare Database
Option Explicit
Sub ListErrors()
On Error GoTo Err_Handler
Dim rst As DAO.Recordset
Dim i As Long, N As Long
Dim strErr As String
'make table if it doesn't exist
If CheckTableExists("tblAccessErrorCodes") = False Then MakeErrorCodesTable
Set rst = CurrentDb.OpenRecordset("tblAccessErrorCodes", dbOpenDynaset)
For i = 1 To 65535
'get generic VBA errors
strErr = Error(i)
'omit unwanted codes
If strErr <> "" And strErr <> "Application-defined or object-defined error" Then
' And strErr <> "|" And strErr <> "|1" And strErr <> "**********" _
' And strErr <> "0,0" And strErr <> "(unknown)") Then
rst.AddNew
rst!ErrNumber = i
rst!ErrDescription = strErr
rst.Update
End If
Next i
For i = 1 To 65535
'now repeat for Access specific errors
strErr = AccessError(i)
'omit all unwanted codes
If strErr <> "" And strErr <> "Application-defined or object-defined error" _
And strErr <> "|" And strErr <> "|1" And strErr <> "**********" _
And strErr <> "0,0" And strErr <> "(unknown)" Then
rst.AddNew
rst!ErrNumber = i
rst!ErrDescription = strErr
rst.Update
End If
Next i
N = rst.RecordCount
rst.Close
Set rst = Nothing
MsgBox "All " & N & " Access errors have been added to the table AccessErrorCodes", vbInformation, "Completed"
Exit_Handler:
Exit Sub
Err_Handler:
If Err = 3022 Then Resume Next 'continue where code already exists
MsgBox "Error " & Err & " : " & Err.description & " in ListErrors procedure"
End Sub
'=============================
Public Function CheckTableExists(TableName As String) As Boolean
On Error Resume Next
'If table exists already then strTableName will be > ""
Dim strTableName As String
strTableName = CurrentDb.TableDefs(TableName).Name
CheckTableExists = Not (strTableName = "")
'Debug.Print strTableName & ": " & CheckTableExists
'next 2 lines added to allow more than 1 table to be checked successfully
strTableName = ""
TableName = ""
End Function
'=============================
Sub MakeErrorCodesTable()
On Error GoTo Err_Handler
'create new table
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim InD As DAO.index
Set tdf = CurrentDb.CreateTableDef("tblAccessErrorCodes")
'Specify the fields.
With tdf
Set fld = .CreateField("ErrNumber", dbLong)
fld.Required = True
.Fields.Append fld
Set fld = .CreateField("ErrDescription", dbMemo)
fld.Required = True
.Fields.Append fld
End With
'create primary key
Set InD = tdf.CreateIndex("PrimaryKey")
With InD
.Fields.Append .CreateField("ErrNumber")
.Unique = False
.Primary = True
End With
tdf.Indexes.Append InD
'Save the table.
CurrentDb.TableDefs.Append tdf
Set fld = Nothing
Set tdf = Nothing
Set InD = Nothing
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox "Error " & Err & " : " & Err.description & " in MakeErrorCodesTable procedure"
End Sub