Hi, Mallory.
If you're like me, thatsa lotsa delete queries. I'd automate it with VBA
code, instead. First, I'd create a table with the following structure:
Table Name: tblDateFields
ID, AutoNumber, primary key
TblName, Text
DateField, Text
Then I'd run the following code to store the table names and date fields in
this new table:
'=============================================
' This sub iterates through all of the fields in each non-system table and
' stores the name of the table and the name of the date field in the
' tblDateFields table.
'=============================================
Public Sub findDateFields()
On Error GoTo ErrHandler
Dim db As Database
Dim tbl As TableDef
Dim idx As Long
Set db = CurrentDb()
For Each tbl In db.TableDefs
If (Left$(tbl.Name, 4) <> "MSys") Then
For idx = 0 To (tbl.Fields.Count - 1)
If (tbl.Fields(idx).Type = dbDate) Then
CurrentDb.Execute "INSERT INTO tblDateFields (TblName,
DateField) " & _
"VALUES ('" & tbl.Name & "', '" &
tbl.Fields(idx).Name & "');", dbFailOnError
End If
Next idx
End If
Next tbl
CleanUp:
Set tbl = Nothing
Set db = Nothing
Exit Sub
ErrHandler:
MsgBox "Error in findDateFields( )." & vbCrLf & vbCrLf & _
"Error #" & Err.Number & vbCrLf & vbCrLf & Err.Description
Err.Clear
GoTo CleanUp
End Sub
Then I'd open the table and ensure that only one date field was saved for
each table. (If there were more than one, I'd have to decide which date
field to keep as the determiner for the "age" of the record, then delete the
others.) Then I'd run the following code whenever I needed to get rid of the
"expired" records:
'=============================================
' This sub iterates through all of the tables in the database (except for the
' non-system tables) and deletes all records more than 180 days old. It
' compares the value in the date field of each table (named date field for
each
' table is stored in the tblDateFields table), then deletes all of the
records more
' than 180 days old. This sub assumes that there is only one date field per
' table. DAO Object Library reference required.
'=============================================
Public Sub deleteExpiredRecs()
On Error GoTo ErrHandler
Dim db As Database
Dim tbl As TableDef
Dim recSet As DAO.Recordset
Dim fldTable As DAO.Field
Dim fldDate As DAO.Field
Dim idx As Long
Dim fOpenedRecSet As Boolean
Dim fDone As Boolean
Set db = CurrentDb()
Set recSet = CurrentDb().OpenRecordset("tblDateFields")
Set fldTable = recSet.Fields("TblName")
Set fldDate = recSet.Fields("DateField")
recSet.MoveLast
For Each tbl In db.TableDefs
recSet.MoveFirst
fDone = False
Do Until (fDone Or recSet.EOF)
If (Left$(tbl.Name, 4) <> "MSys") Then
If (tbl.Name = fldTable.Value) Then
CurrentDb().Execute "DELETE * " & _
"FROM " & tbl.Name & _
" WHERE (" & fldDate.Value & " < Date( ) - 180)",
dbFailOnError
fDone = True
End If
If (Not (recSet.EOF)) Then
recSet.MoveNext
End If
Else
fDone = True
End If
Loop
Next tbl
CleanUp:
Set fldDate = Nothing
Set fldTable = Nothing
Set tbl = Nothing
Set db = Nothing
If (fOpenedRecSet) Then
recSet.Close
fOpenedRecSet = False
End If
Exit Sub
ErrHandler:
MsgBox "Error in deleteExpiredRecs( ) in TestModule." & vbCrLf & vbCrLf
& _
"Error #" & Err.Number & vbCrLf & vbCrLf & Err.Description
Err.Clear
GoTo CleanUp
End Sub
HTH.
Gunny
See
http://www.QBuilt.com for all your database needs.
See
http://www.Access.QBuilt.com for Microsoft Access tips.
(Please remove ZERO_SPAM from my reply E-mail address so that a message will
be forwarded to me.)
- - -
If my answer has helped you, please sign in and answer yes to the question
"Did this post answer your question?" at the bottom of the message, which
adds your question and the answers to the database of answers. Remember that
questions answered the quickest are often from those who have a history of
rewarding the contributors who have taken the time to answer questions
correctly.
:
