Excel VBA - leave 5 newest backups and delete the rest - vba

Question

I have a macro in excel that runs before save and creates a backup of an excel table with the actual date in its name.
These backups started to take too much space, so I have inserted another macro that deletes backups older than 14 days. The problem is that sometimes we don't save new copies for 2 weeks or months, so I need a macro that will leave only the 5 newest backups and delete the rest.
The current macro used:
'======================================================================================
'delete old backup
Set fso = CreateObject("Scripting.FileSystemObject")
For Each fcount In fso.GetFolder(ThisWorkbook.Path & "\" & "excel_backups" & "\").Files
If DateDiff("d", fcount.DateCreated, Now()) > 14 Then
Kill fcount
End If
Next fcount
'======================================================================================
backups are saved in this format:
ThisWorkbook.Path & "\excel_backups" & "\backup_" & Format(Date, "yyyy.mm.dd") & ".h" & Hour(Now) & "_" & ActiveWorkbook.name
so a backup looks like this: backup_2014.12.18.h14_[filename].xlsm
My question is: can this be modified somehow to delete only the oldest ones, and leave the last 5 newest of them? I have no idea how to start writing that.
Thank you for your time.

Answer 1

This may not be the most efficient way but it seems to work as a starting point.
Sub DeleteBackups()
Dim fso As Object
Dim fcount As Object
Dim collection As New collection
Dim obj As Variant
Dim i As Long
Set fso = CreateObject("Scripting.FileSystemObject")
'add each file to a collection
For Each fcount In fso.GetFolder(ThisWorkbook.Path & "\" & "excel_backups" & "\").Files
collection.Add fcount
Next fcount
'sort the collection descending using the CreatedDate
Set collection = SortCollectionDesc(collection)
'kill items from index 6 onwards
For i = 6 To collection.Count
Kill collection(i)
Next i
End Sub
Function SortCollectionDesc(collection As collection)
'Sort collection descending by datecreated using standard bubble sort
Dim coll As New collection
Set coll = collection
Dim i As Long, j As Long
Dim vTemp As Object
'Two loops to bubble sort
For i = 1 To coll.Count - 1
For j = i + 1 To coll.Count
If coll(i).datecreated < coll(j).datecreated Then
'store the lesser item
Set vTemp = coll(j)
'remove the lesser item
coll.Remove j
're-add the lesser item before the greater Item
coll.Add Item:=vTemp, before:=i
Set vTemp = Nothing
End If
Next j
Next i
Set SortCollectionDesc = coll
End Function

Answer 2

Here's what I came up with. It counts the number of files in your backup folder (handy!), calls them out one by one and keeps track of which is the oldest, and finally forcibly deletes the oldest. It does this until there are fewer than six remaining.
Sub DeleteOldFiles()
Dim fso As New FileSystemObject
Dim fil As File
Dim oldfile As File
Dim BackUpPath As String 'This is the FOLDER where your backups are stored
Do Until fso.GetFolder(BackUpPath).Files.Count < 6
For Each fil In fso.GetFolder(BackUpPath).Files
'Checks to see if this file is older than the oldest file thus far
If oldfile Is Nothing Then Set oldfile = fil
If oldfile.DateLastModified > fil.DateLastModified Then Set oldfile = fil
Next fil
fso.DeleteFile oldfile, True
Set oldfile = Nothing
Loop
End Sub
I like this because you don't have to worry what the names are and it's probably marginally quicker than sorting (which shouldn't matter for five files).
One caveat: it requires the scrrun.dll library. The reference is called (in MS Office 2013) Microsoft Scripting Runtime. The FileSystemObject and its associated properties and methods come from this library.
Also, there is a FileSystemObject.CopyFile method that comes with scrrun.dll.
All this will probably also work with CreateObject("Scripting.FileSystemObject") as well, after some variable changes, but I haven't tested it.