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
_______________________________________________________________
