Trying to delete old backup files

[TenOc]

windows 10 Office 2021



I have my backup subroutine working. The problem is I need to automatically delete copies of the backups older than 30 days because the system backup has already backed up all the data as part of the system backup. The error is near the bottom of the code. See screen capture picture below

Option Compare Database
Option Explicit
' This  function copies the Access database to a backup
' location when the database is  opened.
' It does  this only once in any given day.
'  Author:   Mike Perris - mikeperris.com
'  Date:     01-Jun-2012
'  Version:  1.2


Public Function BackupOnOpen()


' ***  CHANGE THE FOLLOWING LINE TO MATCH YOUR BACKUP DESTINATION
' Ensure you have a \ on the end of the pathname.
Const BACKUP_PATH = "F:\NDC Documents\NDC Access\AutoBackup\"


On Error GoTo BackupOnOpen_Err


' If DCount("BackupDate", "tblBackupDetails", "BackupDate = date()") <> 0 Then
 ' Exit Function
' End If


Dim strSourcePath As String
Dim strSourceFile As String
Dim strBackupFile As String
strSourcePath = GetFileName(CurrentDb.Name, False)   '  false means we want pathname
strSourceFile = GetFileName(CurrentDb.Name, True)   '  true means we want filename


strSourcePath = "F:\NDC Documents\NDC Access\"
'strSourceFile = "Beneficiaries.accdb"


strBackupFile = "Backup_ALL  " & Format(Date, "yyyy-mm-dd") _
& " @ " & Format(Now, "hh-nn") & "-" & strSourceFile  ' This Works but time is wrong. Can not get AM/PM to work


 'strBackupFile = "BackupDB-" & Format(Date, "yyyy-mm-dd") _
& "_" & Format(Now, "yyyy-mm-dd hh:nn") & " -  " & strSourceFile


'strBackupFile = "BackupDB-" & "_" & Format(Now, "yyyy-mm-dd hhnn") & " -  " & strSourceFile




' Format(Now, "yyyy-mm-dd hh\:nn\:ss")
'MsgBox strSourcePath & strSourceFile 'Returns correct value
'MsgBox BACKUP_PATH & strBackupFile 'Returns correct value




Dim fso
Set fso = CreateObject("Scripting.FileSystemObject") 'File not found error
fso.CopyFile strSourcePath & strSourceFile, BACKUP_PATH & strBackupFile, True
Set fso = Nothing
DoCmd.SetWarnings False


'Log BackUp details.  Do not need any more


'Dim SQL As String
'SQL = "INSERT INTO tblBackupDetails " _
'  & "(BackupDate, ComputerName, BackupFolder, Filename) " _
 ' & "VALUES ('" & Date & "', '" & Environ("COMPUTERNAME") _
  '& "', '" & BACKUP_PATH & "', '" & strBackupFile & "');"


    'Remove Older log enteries
    'DoCmd.RunSQL SQL
    'SQL = "DELETE * FROM tblBackupDetails WHERE BackupDate < date() - 30;"
    'DoCmd.RunSQL SQL


'Remove Older BackUp files enteries
'    Dim SQL As String
 '   DoCmd.RunSQL SQL
  '  SQL = "DELETE * FROM BACKUP_PATH WHERE BackupDate < date() - 30;"
   ' DoCmd.RunSQL SQL
    'MsgBox "Removed Old Backup.", , "Removed Old Files OK"
    
    'Remove Older BackUp files enteries. SECOND TRY
        Dim fso
        Set fso = CreateObject("Scripting.FileSystemObject") 'File not found error
        fso.deletefile strSourcePath & strSourceFile, BACKUP_PATH & strBackupFile WHERE BackupDate < date() - 30; True
        Set fso = Nothing
        DoCmd.SetWarnings False
        
    
MsgBox "All DB Backed UP.", , "Back Up OK"


DoCmd.SetWarnings True
BackupOnOpen_Exit:
Exit Function
BackupOnOpen_Err:
MsgBox Err.Description, , "BackupOnOpen()"
Resume BackupOnOpen_Exit
End Function
                     
' This  function is given a filename complete with path, and
' a boolean value.
' If the  boolean is true, this function returns only the
' filename (without the path).
' If the  boolean is false, this function returns only the
' path (without the filename).
'  Author:   Mike Perris - mikeperris.com
'  Date:     13-Mar-2011
'  Version:  1.1
' Revision  History:
' Rev       Date(yyyy/mm/dd)        Description
' 1.1       13/3/2011               Added the boolean bit and  extended code to
'                                   extract path  as well as filename.
Function GetFileName(FullPath As String, IsFile As Boolean)
Dim icount  As Integer
icount = Len(FullPath)
Do Until Mid(FullPath, icount, 1) = "\"
 icount = icount - 1
Loop


If IsFile Then
 GetFileName = Right(FullPath, Len(FullPath) - icount)
Else
 GetFileName = Left(FullPath, icount)
End If
End Function

[Welshgasman]

I do not think the FileSystemObject is sql aware

I would expect that you would need to look at each file in the folder and check the dates, either the created or modified date?

I would create a function that would take the file mask and a date.

[TenOc]

The FileSystemObject works in other places in the code. See a few lines above my problem. It is what creates the backup

[Welshgasman]

The FileSystemObject works in other places in the code. See a few lines above my problem. It is what creates the backup

It might well do, but I have never ever seen SQL used with it?, and I am sure that if it was available, someone would have posted something with it's use well before now?

Bit like saying 'Well I use this petrol in all my other cars and it works fine' Yes, but this car is a diesel?

More than happy to be proved wrong as that would be a really neat feature?

https://docs.microsoft.com/en-us/off...mobject-object

[kd2017]

I agree with Welshgasman.

The FileSystemObject works in other places in the code. See a few lines above my problem. It is what creates the backup

fso.CopyFile strSourcePath & strSourceFile, BACKUP_PATH & strBackupFile, True

But that line of code doesn't try to use SQL like this next one does

fso.deletefile strSourcePath & strSourceFile, BACKUP_PATH & strBackupFile WHERE BackupDate < date() - 30; True

Check out examples of how to use the deletefile function: https://analystcave.com/vba-filesyst...ba-deletefile/
Also, filesystemobject.deletefile only accepts 2 parameters but you appear to be trying to pass 3.

You can use wildcards to match against and select file names but this wont help you select files of certain dates (unless of course the date is in the filename). Here's an article to review if you're not familiar with how wildcards work.

As Welshgasman said, you'll need to loop over each filename in the directory one at time, look at its creation date (and maybe filename) and decide whether or not to delete it.

How to loop through files in a directory: https://www.google.com/search?q=vba+...iles+in+folder
How to determine a file's date: https://www.google.com/search?client...+get+file+date

[kd2017]

For your review I've modified your BackupOnOpen function quite a lot and have TESTED NOTHING! Use at your own risk!

Public Function BackupOnOpen()


    ' ***  CHANGE THE FOLLOWING LINE TO MATCH YOUR BACKUP DESTINATION
    ' Ensure you have a \ on the end of the pathname.
    Const BACKUP_PATH = "F:\NDC Documents\NDC Access\AutoBackup\"
    
On Error GoTo BackupOnOpen_Err
    
    Dim strSourcePath As String
    Dim strSourceFile As String
    Dim strBackupFile As String
    Dim fso As Object
    Dim f As Object
    Set fso = CreateObject("Scripting.FileSystemObject") 'File not found error
    
    'strSourcePath = GetFileName(CurrentDb.Name, False)   '  false means we want pathname  '<----- removed this line as it's being reset again 2 line down
    strSourceFile = GetFileName(CurrentDb.Name, True)   '  true means we want filename

    strSourcePath = "F:\NDC Documents\NDC Access\"
    strBackupFile = "Backup_ALL  " & Format(Date, "yyyy-mm-dd") _
                    & " @ " & Format(Now, "hh-nn") & "-" & strSourceFile  ' This Works but time is wrong. Can not get AM/PM to work

    
    DoCmd.SetWarnings False 'I'M NOT SURE THIS IS NECESSARY
    fso.CopyFile strSourcePath & strSourceFile, BACKUP_PATH & strBackupFile, True
    
    '*******************code here to delete old backup files
    Dim fn As String
    fn = Dir(BACKUP_PATH & "Backup_ALL*")
    Do While Len(fn) > 0
        Set f = fso.getfile(fn)
        If f.DateCreated < Date - 30 Then 'if Backup_ALL file were created more than 30 days ago from today
            f.Delete True
        End If
        fn = Dir
    Loop
    '*******************done deleting

    MsgBox "All DB Backed UP.", , "Back Up OK"
    
BackupOnOpen_Exit:
    Set f = Nothing
    Set fso = Nothing
    DoCmd.SetWarnings True
    Exit Function

BackupOnOpen_Err:
    MsgBox Err.Description, , "BackupOnOpen()"
    Resume BackupOnOpen_Exit
End Function

[TenOc]

I found a simply way to do the task using windows scheduler. I am calling this solved

https://jackworthen.com/2018/03/15/c...-x-in-windows/

[Welshgasman]

I found a simply way to do the task using windows scheduler. I am calling this solved

https://jackworthen.com/2018/03/15/c...-x-in-windows/

Good find