VB and VBA Users Source Code: Cleaning and Formating an ADODB error collection into a user friendly message
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Cleaning and Formating an ADODB error collection into a user friendly message
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Tuesday, September 06, 2005
Hits:
2311
Category:
Database/SQL/ADO
Article:
ADO error messages can be verbose and not particularly friendly eg "[INTERSOLV][ODBC SQL Server driver][SQL Server]Stored procedure xxx not found". The function below cleans and formats an ADODB error collection and returns it in a more readable user friendly format. 'Purpose : Cleans and formats an ado error collection (exposed via the Connection.Errors property) 'Inputs : oAdoErrors The collection of errors to clean and format. ' [bReturnNonFatalErrors] If true only returns fatal errors, else returns all errors. 'Outputs : Returns a user friendly formated error message. 'Author : Andrew Baker 'Date : 25/03/2005 'Notes : Function AdoCleanError(oAdoErrors As ADODB.Errors, Optional bReturnNonFatalErrors = True) As String Dim lThisError As Long, sError As String Dim sExistingErrors As String If oAdoErrors Is Nothing = False Then 'Clean and format the errors collection into a single readable string AdoCleanError = "" For lThisError = 0 To oAdoErrors.Count - 1 sError = Trim$(oAdoErrors(lThisError).Description) If oAdoErrors(lThisError).Number = 0 Then If bReturnNonFatalErrors = False Then 'Don't return errors with an error number of zero sError = "" End If End If If Len(sError) > 0 Then sError = Trim$(Mid$(sError, InStrRev(sError, "]") + 1)) 'Remove any trail line feeds If Right$(sError, 1) = vbLf Then sError = Left$(sError, Len(sError) - 1) End If 'Check if we already reported this error If InStr(1, sExistingErrors, sError) = 0 Then 'New error message 'Append error to list AdoCleanError = AdoCleanError & (sError & " (ErrNo: " & oAdoErrors(lThisError).NativeError & ")" & vbNewLine) 'Store reported message sExistingErrors = sExistingErrors & "|" & sError End If End If Next End If If Len(AdoCleanError) Then 'Remove last line feed AdoCleanError = Left$(AdoCleanError, Len(AdoCleanError) - 2) End If End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
