0

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.

Community
  • 1
  • 1
Divin3
  • 538
  • 5
  • 12
  • 27
  • 1
    Look [here](http://stackoverflow.com/questions/16627441/excel-vba-using-filesystemobject-to-list-file-last-date-modified) on using FileSystemObject to return the modified dates of files listed in folder. The way I would do it (may not be the most efficient way) is to list out those dates in a column, put a sort on it, delete top 5 and then loop through the rest of the dates left and delete those uisng the code you have. my two cents. – mrbungle Dec 18 '14 at 16:37

2 Answers2

2

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
michaelf
  • 469
  • 6
  • 20
Stef Joynson
  • 222
  • 3
  • 10
  • 2
    I would use [DateLastModified](http://msdn.microsoft.com/en-us/library/c8xh895w(v=vs.84).aspx) as this date does not change when moving the archive files from disk to disk (e.g. when you backup or restore archived files using next-level storage medium). While file creation date reflects when the file first appeared on the disk. It is disk-local – xmojmr Dec 18 '14 at 20:04
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.

Adam_Hawbaker
  • 21
  • 3