How to check each tbl for a date, then archive all data older than a month? (2 Viewers)

raggajunglist

Registered User.
Local time
Today, 08:54
Joined
Aug 30, 2007
Messages
40
Morning everyone,

Im using Access 2003 to try and create a sort of auto-archive function,
(i will stick on AutoExec when finished)
I have so far only managed to loop through all the tables but don't seem to be able to view the tables for fields like DATE or DATADATE.

I figure the append query would possible contain the code to loop through the tables and perform the append on each that met certain criteria?

Can anyone help me figure this out?

Many thanks

M
 

ecawilkinson

Registered User.
Local time
Today, 16:54
Joined
Jan 25, 2005
Messages
112
Could you be a bit clearer? When you say auto-archive, how are you going about it? I assume that you want to move any records older than a certain date to in a table to an archive version of the table. Also, did you define "last modified date" fields for each table to help you work out which records to archive?
 

raggajunglist

Registered User.
Local time
Today, 08:54
Joined
Aug 30, 2007
Messages
40
Hi, thanks for the reply.

Yes for all of the tables i want to archive there is a date modified field, some do not but i want the code to skip over those (Msys*, queries, Linked tables etc)

I meant auto as in AUTOEXEC, so each time the BE_database is loaded in the morning it will check to see if any files need archiving.
Also yes, i am wishing to append all the records that meet the date criteria to be sent of to an archive table.
I would have envisioned it as being an append query nested inside some vba function called from the AUTOEXEC macro?


Hope this makes sense, let me know if not.

Thanks

M
 
Last edited:

ecawilkinson

Registered User.
Local time
Today, 16:54
Joined
Jan 25, 2005
Messages
112
hi,

create a procedure in a module:
Code:
function ArchiveTables()
    Dim tdf As DAO.TableDef
    Dim db As DAO.Database
    Dim fld As DAO.Field
    Dim yourdate As Date
    Dim lErr As Long
    yourdate = DateAdd("m", -1, Date) ' one month ago
    
    Set db = CurrentDb
    
    For Each tdf In db.TableDefs
        On Error Resume Next
        Set fld = tdf.Fields("DateModified")
        lErr = Err
        On Error GoTo 0
        If lErr = 0 And Left(tdf.Name, 3) <> "arc" Then
            db.Execute "INSERT INTO Arc" & tdf.Name & " " & _
                "SELECT * FROM " & tdf.Name & " WHERE DateModified < " & CDbl(yourdate)
            db.Execute "DELETE * FROM " & tdf.Name & " WHERE DateModified < " & CDbl(yourdate)
        End If
        
    Next tdf

end sub
The code above will work if each of the tables you want to archive has a field called DateMOdified (or similar) and your archive tables are the same name as the table with a arc prefix, i.e. Table1 has arcTable1, table2 as arctable2. Again, you can use any prefix/suffix/naming convention as long as it is consistent.
I'm sure with some trweaking, you can get the above to work, just called it from an autoexec macro (using the RunCode command).

HTH,
Chris
 

raggajunglist

Registered User.
Local time
Today, 08:54
Joined
Aug 30, 2007
Messages
40
Chris,

Many thanks for the response,

This is perfect, i'd never used DAO before !!! i shall have to pull my finger out and get learning:)

Mike
 

raggajunglist

Registered User.
Local time
Today, 08:54
Joined
Aug 30, 2007
Messages
40
Hi again,

I've tried playing around with your code a bit but have seemingly run into a wall again..

Function ArchiveNumbers()
Dim tdf As DAO.TableDef
Dim db As DAO.Database
Dim fld As DAO.Field
Dim myDate As Date
Dim lErr As Long
Dim mySQL As String
myDate = EOMonth(Date, -1)

Set db = CurrentDb

For Each tdf In db.TableDefs
On Error Resume Next
lErr = Err
On Error GoTo 0
If lErr = 0 And Left(tdf.Name, 3) <> "ARC" And Left(tdf.Name, 10) = "tblNumbers" Then
Set fld = tdf.Fields("Date")


'//create the table
CreateArchiveTableNums
myTbl = "ARCHIVED_NUMBERS: " & Date


mySQL = "INSERT INTO [" & myTbl & "] SELECT * FROM " & tdf.Name & " WHERE Date <= " & CDbl(myDate)
Debug.Print mySQL
db.Execute mySQL
'mySQL = ""
'mySQL = "DELETE * FROM " & tdf.Name & " WHERE Date <= " & CDbl(myDate)
'db.Execute mySQL

End If

Next tdf


End Function

The resulting SQL seems fine, it even deletes the data from the tables (which are older than a month) it just wont insert into the created table, why would this happen?

INSERT INTO [ARCHIVED_NUMBERS: 29/05/2008] SELECT * FROM tblNumbers1 WHERE Date <= 30/04/2008

Any suggestions are much appreciated
 

ecawilkinson

Registered User.
Local time
Today, 16:54
Joined
Jan 25, 2005
Messages
112
RaggaJunglist,

the reason I used cdbl(yourdate), is so that you do not run into date conversion problems. Using #30/04/08# is easy to handle, as Access makes an educated guess but if you are in UK and put #05/04/2008#, The DAO SQL will take that as 4th April 2008 not 5th May 2008. Do as I did, create a variable of date type, then convert it into a number (double if it is date and time, long if it is just a date). So you should use Clng(CutOffDate). To get a date of one month ago use:
Code:
Dim CutOffDate As Date
CutOffDate = DateAdd("m", -1, Date)
then use clng(CutOffDate) in the SQL statement. This may seem odd but it will save a world of pain later when you are stuck trying to work out why on 02/06/2008, records from 01/05/2008 are not being removed (DAO thinks you mean 05/01/2008).

HTH,
Chris
 

raggajunglist

Registered User.
Local time
Today, 08:54
Joined
Aug 30, 2007
Messages
40
ok that makes sense, i shall do that now!

thanks for your help chris, much appreciated!!
 

Users who are viewing this thread

Top Bottom