Suppress warnings, but show error messages


H

Helge V. Larsen

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?
 
Ad

Advertisements

Ad

Advertisements

H

Helge V. Larsen

My attachment was considered unsafe by OE and removed. Therefore I insert it
here:

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
_______________________________________________________________
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top