Suppress warnings, but not error messages

[HelgeLarsen]

I have some VBA that loops through a list of tables, empties them, and then fills them again by running append queries.
For each table I get messages like "You are about to delete 123 row(s) from the specified table" and "You are about to append 456 row(s)". These messages I can suppress by "DoCmd.SetWarnings (False)".
But if some error happens when appending records, the accompanying error message is also suppressed. An error message could for instance be "<Database> can't append all records in the append query. <Database> set 7 field(s) to Null due to type conversion failure, ... ...".

How can I suppress the warning messages and still get any error messages?



________________________
Helge Larsen

 

[Remou]

You could use:

Dim db As Database

On Error GoTo Error_Handler:

    Set db = CurrentDb

    db.Execute "Test", dbFailOnError
    
    
Exit_Here:
    Exit Sub
    
Error_Handler:
    Dim strError As String
    Dim errLoop As Object
    
    ' Enumerate Errors collection and display properties of
    ' each Error object.
    For Each errLoop In Errors
       With errLoop
          strError = _
             "Error #" & .Number & vbCrLf
          strError = strError & _
             "  " & .Description & vbCrLf
          strError = strError & _
             "  (Source: " & .Source & ")" & vbCrLf
       End With
       Debug.Print strError
    Next
    
    Err.Clear

Further Information:

http://msdn.microsoft.com/en-us/library/bb177491.aspx

http://lessthandot.com

 

[44nato44]

Not sure if you can use something like this :

On Error GoTo Err_Command224_Click

Err_Command224_Click:
Resume Exit_Command224_Click

 

[HelgeLarsen]

Thanks to
'Remou'
on

http://www.tek-tips.com

and
Allen Browne - Microsoft MVP, Perth, Western Australia,

http://allenbrowne.com/ser-60.html

on microsoft.public.access
and
Roger Carlson - MS Access MVP,

http://www.rogersaccesslibrary.com

on microsoft.public.access.modulescoding,
microsoft.public.office.developer.vba
for valuable answers.

The main idea is to use DB.Execute instead of DoCmd.RunSQL.

If interested, please find my solution below.


Helge V. Larsen
Risoe National Laboratory for Sustainable Energy

http://www.risoe.dtu.dk

__________________________________________________

Function HVL_Run_Action_Queries() As Boolean

Dim DB As Database, anError As Error, sError As String
Dim aTable As String, aQuery As String, SQL As String
Dim i As Long
Dim OK As Boolean

OK = True

' Set names of queries and tables
Call HVL_Initialize_Trans

' Check that all queries and tables exist :
For i = 1 To N_Update
aQuery = UpdateQuery(i)
If Not HVL_Query_Exist(aQuery) Then
OK = False
MsgBox "Function HVL_Run_Action_Queries :" & vbCr & _
"Update query """ & aQuery & """ does not exist !", vbCritical, "ERROR"
End If
Next i
For i = 1 To N_Trans
aQuery = TransQuery(i)
aTable = TransTable(i)
If Not HVL_Query_Exist(aQuery) Then
OK = False
MsgBox "Function HVL_Run_Action_Queries :" & vbCr & _
"'Trans' query """ & aQuery & """ does not exist !", vbCritical, "ERROR"
End If
If Not HVL_Table_Exist(aTable) Then
OK = False
MsgBox "Function HVL_Run_Action_Queries :" & vbCr & _
"'Trans' table """ & aTable & """ does not exist !", vbCritical, "ERROR"
End If
Next i

If Not OK Then GoTo Exit_Function

' Uses DB.Execute instead of DoCmd.RunSQL
' Warnings are not shown.
' Errors can be trapped.

Set DB = CurrentDb

' Running update queries
On Error GoTo Err_Lab1
For i = 1 To N_Update
aQuery = UpdateQuery(i)
HVL_Log_Write ("Running Update query """ & aQuery & """.")
DB.Execute aQuery, dbFailOnError
HVL_Log_Write (" " & DB.RecordsAffected & " records affected.")
Next i
HVL_Log_Write ("...")

' Replacing subqueries by tables
On Error GoTo Err_Lab2
For i = 1 To N_Trans
aQuery = TransQuery(i)
aTable = TransTable(i)
SQL = "DELETE [" & aTable & "].* FROM [" & aTable & "];"
HVL_Log_Write ("Deleting all records in table """ & aTable & """.")
DB.Execute SQL, dbFailOnError
HVL_Log_Write (" " & DB.RecordsAffected & " records deleted.")
SQL = "INSERT INTO [" & aTable & "] SELECT [" & aQuery & "].* FROM [" & aQuery & "];"
HVL_Log_Write ("Copying all records from query """ & aQuery & """ to table """ & aTable & """.")
DB.Execute SQL, dbFailOnError
HVL_Log_Write (" " & DB.RecordsAffected & " records copied.")
Next i
On Error GoTo 0
HVL_Log_Write ("All action queries finished.")
HVL_Log_Write ("...")

Exit_Function:
Set DB = Nothing
Set anError = Nothing
HVL_Run_Action_Queries = OK
Exit Function

Err_Lab1:
For Each anError In Errors
With anError
sError = vbCr
sError = sError & "Error #" & .Number & vbCr
sError = sError & " " & .Description & vbCr
sError = sError & " (Source: " & .Source & ")" & vbCr
End With
Debug.Print sError
Next
Err.Clear
MsgBox "Function HVL_Run_Action_Queries." & vbCr & vbCr & _
"Update query: " & aQuery & vbCr & _
"No records are updated." & vbCr & _
sError, _
vbCritical, "Error"
Call HVL_Log_Write(" --- ERROR : Update query failed !")
Resume Next

Err_Lab2:
For Each anError In Errors
With anError
sError = vbCr
sError = sError & "Error #" & .Number & vbCr
sError = sError & " " & .Description & vbCr
sError = sError & " (Source: " & .Source & ")" & vbCr
End With
Debug.Print sError
Next
Err.Clear
MsgBox "Function HVL_Run_Action_Queries." & vbCr & vbCr & _
"Append query: " & aQuery & vbCr & _
"Table : " & aTable & vbCr & vbCr & _
"No records are appended to the table." & vbCr & _
sError, _
vbCritical, "Error"
Call HVL_Log_Write(" --- ERROR : Append query failed !")
Resume Next

End Function


________________________
Helge Larsen