Archiving Problems

[492JQS]

I'm new to access and began work on my first database a couple of months ago. This site has been a great help, and up to now I've been able to find all the advice I need by searching the forums.
However, I now have a problem that doesn't seem to be covered in previous posts. I'm using the following code (taken from this site) on the OnClose event of my switchboard to backup the DBase backend:

Public Function BackupAndZipit()

'This function will allow you to copy a db that is open,
'rename the copied db and zip it up to anther folder.

'You must set a reference to the 'Microsoft Scripting Runtime' for the CopyFile piece to work!

'Thanks to Ricky Hicks for the .CopyFile code

Dim fso As FileSystemObject

Dim sSourcePath As String
Dim sSourceFile As String
Dim sBackupPath As String
Dim sBackupFile As String

sSourcePath = "MyDBaseFilePath\"
sSourceFile = "MyDBaseBackend"
sBackupPath = "MyBackupPath\"
sBackupFile = "BackupDB_" & Format(Date, "mmddyyyy") & ".mdb"

Set fso = New FileSystemObject
fso.CopyFile sSourcePath & sSourceFile, sBackupPath & sBackupFile, True
Set fso = Nothing

Dim sWinZip As String
Dim sZipFile As String
Dim sZipFileName As String
Dim sFileToZip As String

sWinZip = "C:\Program Files\WinZip\WinZip32.exe" 'Location of the WinZip program
sZipFileName = Left(sBackupFile, InStr(1, sBackupFile, ".", vbTextCompare) - 1) & ".zip"
sZipFile = sBackupPath & sZipFileName
sFileToZip = sBackupPath & sBackupFile

Call Shell(sWinZip & " -a " & sZipFile & " " & sFileToZip, vbHide)

DoEvents

If Dir(sZipFile) <> "" Then

Kill sZipFile

End If

Beep
MsgBox "Backup was successful and saved @ " & Chr(13) & Chr(13) & sBackupPath & Chr(13) & Chr(13) & "The backup file name is " & Chr(13) & Chr(13) & sZipFileName, vbInformation, "Backup Completed"

If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile)

End Function


And I'm using the code below on my switchboard OnLoad event to delete backup files older than ten days:

Dim checkFile
checkFile = Dir(MyBackupPath & "\*.zip", vbDirectory) ' Retrieve the first entry.
Do While checkFile <> "" ' Start the loop.
If (Now - FileDateTime(MyBackupPath & "\" & checkFile)) > 10 Then
Kill MyBackupPath & "\" & checkFile 'Delete file as it is older than 10 days
End If
checkFile = Dir ' Get next entry.
Loop

All of this works fine, but I still have a problem. If the database is not used for ten days or more, all of the backup files will be deleted when the switchboard is next opened, so if one of the users (there are only three) messes everything up on his first day back from holiday I'll have no backup files.

What I wanted to do was modify the code to leave the latest backup file even if it is more than ten days old, but I haven't got a clue how to do this. Can anyone help?

The only other option I can think of is to add the backup code to the switchboard OnLoad event so the backend is backed-up when the DBase is opened.

Any suggestions would be gratefully received.

JQS