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
_______________________________________________________________
Helge V. Larsen said:
Thanks to
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
and
'Remou'
on
http://www.tek-tips.com
for valuable answers.
The main idea is to use DB.Execute instead of DoCmd.RunSQL.
If interested, please find my solution attached.
Helge V. Larsen
Senior Scientist
Risoe National Laboratory for Sustainable Energy
www.risoe.dtu.dk
______________________________________
