"Geoff" <gf****@freenetname.co.uk> wrote in message
news:XI******************************@brightview.c om...
I want to archive records from one recordset to another recordset. Not too
sure of what to do in commented areas shown below.
Dim Db As DAO.Database
Dim Rec1 As DAO.Recordset 'Set as Global Variables
Dim Rec2 As DAO.Recordset
Public Sub OpenRecSet()
Set Db = CurrentDb()
Set Rec2 = Db.OpenRecordset("Tbl_Archive2004_5", dbOpenDynaset)
Set Rec1 = Db.OpenRecordset("Tbl_Emp", dbOpenDynaset)
End Sub
Private Sub But1_Click()
' Record Set1 is read, one record at a time. If the date in a rec is less
than
' the date on the form, it is to be archived to Tbl_Archive2004_5.
OpenRecSet
Do
If Rec1("Date_of_Job") < Me.ArchDate Then
'Copy Rec1 to Tbl_Archive2004_5
'Delete the record from Tbl_Emp
End If
Rec1.MoveNext
Loop Until Rec1.EOF
Rec1.Close
Rec2.Close
End Sub
Any help will be greatly received
Geoff
As your other two replies point out, transactions are the way forward. In
this version, I add records to one table and then delete them from the
first - if the two counts match, I commit the transaction.
What nobody has yet commented on is whther you really need to archive.
According to my statistics, the average Access Developer uses archiving
73.2% more often than is really required. In other words, are you really
sure you need to move the data to another table? What improvements (in
speed or otherwise) do you think you will achieve? What steps have you
taken to show this increase in speed (efficiency or whatever) before you go
ahead and implement the archiving routine?
Public Sub DoArchive()
On Error GoTo Err_Handler
Dim lngRecCount As Long
lngRecCount = ArchiveRecords("Tbl_Emp", "Tbl_Archive2004_5",
DateSerial(2006, 3, 8))
MsgBox CStr(lngRecCount) & " record(s) archived", _
vbInformation, "Archive Routine"
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Sub
Public Function ArchiveRecords(SourceTable As String, _
TargetTable As String, _
StartDate As Date) As Long
On Error GoTo Err_Handler
Dim wks As DAO.Workspace
Dim dbs As DAO.Database
Dim dteDate As Date
Dim strSQL As String
Dim lngAdded As Long
Dim lngDeleted As Long
dteDate = DateSerial(Year(StartDate), _
Month(StartDate), _
Day(StartDate))
dteDate = DateAdd("d", 1, dteDate)
Set wks = DBEngine.Workspaces(0)
wks.BeginTrans
Set dbs = wks.Databases(0)
strSQL = "INSERT INTO " & TargetTable & _
" SELECT * FROM " & SourceTable & _
" WHERE ComDate<#" & _
Format(dteDate, "yyyy-mm-dd") & "#"
dbs.Execute strSQL, dbFailOnError
lngAdded = dbs.RecordsAffected
strSQL = "DELETE FROM " & SourceTable & _
" WHERE ComDate<#" & _
Format(dteDate, "yyyy-mm-dd") & "#"
dbs.Execute strSQL, dbFailOnError
lngDeleted = dbs.RecordsAffected
If lngAdded = lngDeleted Then
wks.CommitTrans
ArchiveRecords = lngAdded
Else
wks.Rollback
End If
Exit_Handler:
If Not dbs Is Nothing Then
Set dbs = Nothing
End If
If Not wks Is Nothing Then
Set wks = Nothing
End If
Exit Function
Err_Handler:
MsgBox Err.Description, vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Function
