Save Backup File - Delete older versions keeping only the newest 20

[Falko26]

Hey Team,

I'm trying to create a Backup folder for a specific Excel File.

The idea is that whenever someone hits the save button it will automatically save a back up file to the a folder location of my choosing. Then it will count the number of files, keep the newest "10 lets say" and delete the oldest one. Is something like that possible?

Here is my current code. This will create backups with a time stamp. The next step is deleting the older files past the count of 10.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim AWB As Workbook, BackupFileName As String, i As Integer, Ok As Boolean

On Error GoTo NotAbleToSave
    
Set AWB = ActiveWorkbook

'Assign full path of file along file name to variable BackupFileName
' BackupFileName = AWB.FullName

NameBase = Format(Now, "mm.dd.yyyy hh.mm")
TName = ActiveWorkbook.Name
BackupFileName = "C:\MM_Backup File\" & NameBase & " " & TName & " "


'Checking whether file is saved
'If file is not saved then saving the file
If AWB.Path = "" Then
    'Displaying Save as dialog box for file saving
    Application.Dialogs(xlDialogSaveAs).Show
Else
    
    'Removing file extension from file name
    i = 0
    While InStr(i + 1, BackupFileName, ".") > 0
    'Find the extension of file
        i = InStr(i + 1, BackupFileName, ".")
    Wend
    
    If i > 0 Then BackupFileName = Left(BackupFileName, i - 1)
    
    'Adding back up extension ".bak" with file name
    BackupFileName = BackupFileName & ".bak"
    Ok = False
    
    With AWB
        .Save
        'Creating Backup of file
        .SaveCopyAs BackupFileName
        Ok = True
    End With
End If

NotAbleToSave:
'Code for error handling
    Set AWB = Nothing
    If Not Ok Then
        MsgBox "Material Master has been saved. However, The Backup Copy cannot be saved without m/Link folder setup.", vbExclamation, ThisWorkbook.Name
    End If
End Sub

 

[John_w]

It might be better to use the Workbook_AfterSave event rather than Workbook_BeforeSave, because then you know that the user has saved the workbook and the code just has to create the backup and delete the oldest backup(s).

Private Sub Workbook_AfterSave(ByVal Success As Boolean)

    Dim FullBackupFile As String, FullBackupFileLike As String
    Dim BackupFolder As String
   
    BackupFolder = "C:\MM_Backup File\"
    If Right(BackupFolder, 1) <> "\" Then BackupFolder = BackupFolder & "\"
   
    With ActiveWorkbook
   
        'Create backup
       
        FullBackupFile = BackupFolder & Format(Now, "mm.dd.yyyy hh.mm") & " " & Left(.Name, InStrRev(.Name, ".")) & "bak"
        FullBackupFileLike = BackupFolder & "##.##.#### ##.##" & " " & Left(.Name, InStrRev(.Name, ".")) & "bak"
        .SaveCopyAs FullBackupFile
       
        'Delete oldest backups, keeping the newest 10
       
        Delete_Oldest_Backups 10, FullBackupFileLike
   
    End With
       
End Sub


Private Sub Delete_Oldest_Backups(numToKeep As Long, FullBackupFileLike As String)

    Dim folderPath As String, fileNameLike As String, fileName As String
    Dim dateFile As String, i As Long
    Dim filesArray As Object
   
    Set filesArray = CreateObject("System.Collections.ArrayList")
   
    folderPath = Left(FullBackupFileLike, InStrRev(FullBackupFileLike, "\"))
    fileNameLike = Mid(FullBackupFileLike, InStrRev(FullBackupFileLike, "\") + 1)
    fileName = Dir(folderPath & "*.*")
    Do While fileName <> vbNullString
        If LCase(fileName) Like LCase(fileNameLike) Then
            dateFile = CDbl(FileDateTime(folderPath & fileName)) & "|" & fileName
            filesArray.Add dateFile
        End If
        fileName = Dir()
    Loop
   
    filesArray.Sort
    filesArray.Reverse
   
    For i = numToKeep To filesArray.Count - 1
        Debug.Print "DELETE " & folderPath & Split(filesArray(i), "|")(1)
        Kill folderPath & Split(filesArray(i), "|")(1)
    Next
   
End Sub

 

[Falko26]

Hey John,

Thank you very much for the reply!

I input your code and it seams to create the backup perfectly. Much cleaner than my code. But when it tries to delete oldest backups it errors out and tries to debug with the line:
Set filesArray = CreateObject("System.Collections.ArrayList")

Any ideas?

Thanks again.

 

[John_w]

You probably need to install .NET Framework 3.5. See automation error -2146232576 (80131700) on creating an array

 

[Falko26]

Perfect!

Problem Solved works perfectly John Thank you very much!!

 

[HighAndWilder]

It might be better to use the Workbook_AfterSave event rather than Workbook_BeforeSave, because then you know that the user has saved the workbook and the code just has to create the backup and delete the oldest backup(s).

Private Sub Workbook_AfterSave(ByVal Success As Boolean)

    Dim FullBackupFile As String, FullBackupFileLike As String
    Dim BackupFolder As String
  
    BackupFolder = "C:\MM_Backup File\"
    If Right(BackupFolder, 1) <> "\" Then BackupFolder = BackupFolder & "\"
  
    With ActiveWorkbook
  
        'Create backup
      
        FullBackupFile = BackupFolder & Format(Now, "mm.dd.yyyy hh.mm") & " " & Left(.Name, InStrRev(.Name, ".")) & "bak"
        FullBackupFileLike = BackupFolder & "##.##.#### ##.##" & " " & Left(.Name, InStrRev(.Name, ".")) & "bak"
        .SaveCopyAs FullBackupFile
      
        'Delete oldest backups, keeping the newest 10
      
        Delete_Oldest_Backups 10, FullBackupFileLike
  
    End With
      
End Sub


Private Sub Delete_Oldest_Backups(numToKeep As Long, FullBackupFileLike As String)

    Dim folderPath As String, fileNameLike As String, fileName As String
    Dim dateFile As String, i As Long
    Dim filesArray As Object
  
    Set filesArray = CreateObject("System.Collections.ArrayList")
  
    folderPath = Left(FullBackupFileLike, InStrRev(FullBackupFileLike, "\"))
    fileNameLike = Mid(FullBackupFileLike, InStrRev(FullBackupFileLike, "\") + 1)
    fileName = Dir(folderPath & "*.*")
    Do While fileName <> vbNullString
        If LCase(fileName) Like LCase(fileNameLike) Then
            dateFile = CDbl(FileDateTime(folderPath & fileName)) & "|" & fileName
            filesArray.Add dateFile
        End If
        fileName = Dir()
    Loop
  
    filesArray.Sort
    filesArray.Reverse
  
    For i = numToKeep To filesArray.Count - 1
        Debug.Print "DELETE " & folderPath & Split(filesArray(i), "|")(1)
        Kill folderPath & Split(filesArray(i), "|")(1)
    Next
  
End Sub

I was unaware of System.Collections.ArrayList. It certainly makes certain array manipulations easier. Yet another thing to put on my list of things to investigate further. I had developed something but it involved populating and sorting a worksheet.