I have a database for tracking tasks. each task may have associated documents for it which are kept in a separate table.
I have an archiving procedure which takes closed or completed tasks (from the main table) and appends them to an archive table but it leaves the associated documents in the second table, or if I enforce integrity it will delete them.
Anyone have a suggestion on how i can archive records from two tables at the same time I include the archive code for your information....
Many Thanks as always for your help and assistance
I have an archiving procedure which takes closed or completed tasks (from the main table) and appends them to an archive table but it leaves the associated documents in the second table, or if I enforce integrity it will delete them.
Anyone have a suggestion on how i can archive records from two tables at the same time I include the archive code for your information....
Many Thanks as always for your help and assistance
Code:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' procedure archives closed or complete records to archive table and then '
' Deletes original records from source table '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error GoTo Err_btnArchiveAdhoc_Click
Dim strMySql As String, strResponse As String, intRecordCount As Integer
Dim cnn As ADODB.Connection
Dim rstTemp As ADODB.Recordset
strResponse = MsgBox("By clicking Yes you will Archive any closed or" & _
vbCrLf & "completed tasks and delete the original records from the table", vbExclamation + vbYesNo, gstrAppTitle)
If strResponse = vbNo Then
Exit Sub
Else
Set cnn = CurrentProject.Connection
Set rstTemp = New ADODB.Recordset
' builds sql string to append closed or complete records from the original table into archive table
strMySql = "INSERT INTO tblArchiveAdHocTasks ( Seq_Number, Item_Type, TaskTitle, Task_Description, TaskActions, StartDate, TgtDate, ReviewDate, TaskLead, Status, LastUpdatedBy, estHours, Progress, PersIDAssocPerson1, PersIDAssocPerson2, PersIDAssocPerson3, PersIDAssocPerson4, PersIDAssocPerson5 )"
strMySql = strMySql + " SELECT tblAdHocTask.Seq_Number, tblAdHocTask.Item_Type, tblAdHocTask.TaskTitle, tblAdHocTask.Task_Description, tblAdHocTask.TaskActions, tblAdHocTask.StartDate, tblAdHocTask.TgtDate, tblAdHocTask.ReviewDate, tblAdHocTask.TaskLead, tblAdHocTask.Status, tblAdHocTask.LastUpdatedBy, tblAdHocTask.estHours, tblAdHocTask.Progress, tblAdHocTask.PersIDAssocPerson1, tblAdHocTask.PersIDAssocPerson2, tblAdHocTask.PersIDAssocPerson3, tblAdHocTask.PersIDAssocPerson4, tblAdHocTask.PersIDAssocPerson5"
strMySql = strMySql + " FROM tblAdHocTask "
strMySql = strMySql + " WHERE (((tblAdHocTask.Status)=6 Or (tblAdHocTask.Status)=10))" ' status 6 is closed and 10 is complete
DoCmd.SetWarnings False
'DoCmd.RunSQL strMySql ' runs append query
rstTemp.CursorLocation = adUseClient
rstTemp.Open strMySql, cnn, adOpenDynamic, adLockOptimistic
DoCmd.SetWarnings True ' turn warnings back on
' deletes records that have been archived above
strMySql = "DELETE tblAdHocTask.Seq_Number, tblAdHocTask.Item_Type, tblAdHocTask.TaskTitle, tblAdHocTask.Task_Description, tblAdHocTask.TaskActions, tblAdHocTask.StartDate, tblAdHocTask.TgtDate, tblAdHocTask.ReviewDate, tblAdHocTask.TaskLead, tblAdHocTask.Status, tblAdHocTask.LastUpdatedBy, tblAdHocTask.estHours, tblAdHocTask.Progress, tblAdHocTask.PersIDAssocPerson1, tblAdHocTask.PersIDAssocPerson2, tblAdHocTask.PersIDAssocPerson3, tblAdHocTask.PersIDAssocPerson4, tblAdHocTask.PersIDAssocPerson5"
strMySql = strMySql + " FROM tblAdHocTask"
strMySql = strMySql + " WHERE (((tblAdHocTask.Status) = 6 Or (tblAdHocTask.Status) = 10))" ' status 6 is closed status 10 is complete
rstTemp.CursorLocation = adUseClient
rstTemp.Open strMySql, cnn, adOpenDynamic, adLockOptimistic
End If
MsgBox "Export Complete ", vbInformation, gstrAppTitle
Exit_btnArchiveAdhoc_Click:
Exit Sub
Err_btnArchiveAdhoc_Click:
If Err.Number = 2501 Then ' runtime error as user cancelled delete part of query
Exit Sub
End If
MsgBox "'Error" & Err.Number & "'" & vbCrLf & Err.Description
Resume Exit_btnArchiveAdhoc_Click
End Sub