Function
AccessAndJetErrorsTable() As Boolean Dim cat As New ADOX.Catalog Dim tbl As New ADOX.Table Dim cnn As ADODB.Connection Dim rst As New ADODB.Recordset, lngCode As Long Dim strAccessErr As String Const conAppObjectError = "Application-defined or object-defined error" On Error GoTo Error_AccessAndJetErrorsTable Set cnn = CurrentProject.Connection ' Create Errors table with ErrorNumber and ErrorDescription fields. tbl.Name = "AccessAndJetErrors" tbl.Columns.Append "ErrorCode", adInteger tbl.Columns.Append "ErrorString", adLongVarWChar Set cat.ActiveConnection = cnn cat.Tables.Append tbl ' Open recordset on Errors table. rst.Open "AccessAndJetErrors", cnn, adOpenStatic, adLockOptimistic ' Loop through error codes. For lngCode = 0 To 3500 On Error Resume Next ' Raise each error. strAccessErr = AccessError(lngCode) DoCmd.Hourglass True ' Skip error numbers without associated strings. If strAccessErr <> "" Then ' Skip codes that generate application or object-defined errors. If strAccessErr <> conAppObjectError Then ' Add each error code and string to Errors table. rst.AddNew rst!ErrorCode = lngCode ' Append string to memo field. rst!ErrorString = strAccessErr rst.Update End If End If Next lngCode ' Close recordset. rst.Close DoCmd.Hourglass False RefreshDatabaseWindow MsgBox "Access and Jet errors table created." AccessAndJetErrorsTable = True Exit_AccessAndJetErrorsTable: Exit Function Error_AccessAndJetErrorsTable: MsgBox Err & ": " & Err.Description AccessAndJetErrorsTable = False Resume Exit_AccessAndJetErrorsTable End Function |