VBScript to get directory size if over N GB then delete oldest 'Folder' to recover space

Viewed 531

I'm very new to bat scripting and would like to be able to do the following:

I have a main 'backups' folder which in turn contains unique folders for individual daily backups taken (i.e. named 'backup (date/time'). Within these individual daily backup folders they contain both files and folders.

I would therefore like to be able to check the main 'backups' folder and if the size is greater then say 50GB then the oldest folder and anything contained within is deleted.

I came across the script below in the Forum which does what I'm looking for, but on files rather then folders. Due to my elementally level of scripting, I'm not sure how straightforward it would be to adapt have it work with folders or if there is something else already available.

Many Thanks

Set fso = CreateObject("Scripting.FileSystemObject")
Set F = fso.GetFolder("C:\Users\User\Desktop\New Folder\Stories\Test")

If F.size > 2^30*2 Then

'Comments on a stupid editor that can't handle tabs
        'Creating an in memory disconnected recordset to sort files by date
    Set rs = CreateObject("ADODB.Recordset")
    With rs
        .Fields.Append "Date", 7 
        .Fields.Append "Txt", 201, 5000 
        .Open

        For Each Thing in f.files
            .AddNew
            .Fields("Date").value = thing.datelastmodified
            .Fields("Txt").value = thing.path
            .UpDate
        Next
        .Sort = "Date Desc"
        Do While not .EOF
            fso.deletefile  .Fields("Txt").Value
            If f.size < 2^30*2 then Exit Do
            .MoveNext
        Loop
    End With
End If
2 Answers

Here's code that does what you are looking for:

Dim objFSO

PurgeBackups "C:\Temp"

Sub PurgeBackups(p_sRootFolder)
    Dim objRootFolder
    Dim objOldestFolder
    Dim fOldestInitialized
    Dim objFolder
    Dim lngFolderSize

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objRootFolder = objFSO.GetFolder(p_sRootFolder)
    fOldestInitialized = False

    For Each objFolder In objRootFolder.SubFolders

        lngFolderSize = GetFolderSize(objFolder)

        If lngFolderSize > 50000000000# Then

            ' Decide if you want to delete this Folder or not
            If Not fOldestInitialized Then
                Set objOldestFolder = objFolder
                fOldestInitialized = True
            End If

            ' Compare date
            If objFolder.DateCreated < objOldestFolder.DateCreated Then
                Set objOldestFolder = objFolder
            End If

        End If

    Next

    If fOldestInitialized Then
        ' Delete oldest folder
        objOldestFolder.Delete
    End If

End Sub    

Function GetFolderSize(p_objFolder)
    Dim objFile
    Dim objFolder
    Dim lngFolderSize

    lngFolderSize = 0

    For Each objFile In p_objFolder.Files
        lngFolderSize = lngFolderSize + objFile.Size
    Next

    For Each objFolder In p_objFolder.SubFolders
        lngFolderSize = lngFolderSize + GetFolderSize(objFolder)
    Next

    GetFolderSize = lngFolderSize

End Function

Please find below my attempt which has been based on an existing script and modified to suit, with a few extra flurries . . . I would be grateful for comment.

strOldestFolder = ""
dtmOldestDate = Now

Set oShell = CreateObject("WScript.Shell")
strHomeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%\HDBackups")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strHomeFolder)

intFolderSize = Int((objFolder.Size / 1024) / 1024)

If intFolderSize >= 50 Then ' change as appropriate, value in MBytes
    Set objSubFolders = objFolder.SubFolders
    For Each objFolder in objSubFolders
        strFolder = objFolder.Path
        dtmFolderDate = objFolder.DateCreated
        If dtmFolderDate < dtmOldestDate Then
            dtmOldestDate = dtmFolderDate
            strOldestFolder = strFolder
        End If
    Next
    objFSO.DeleteFolder(strOldestFolder)
End If

One aspect that I'm not entirely happy with is the look and neatness of the 'str' and 'Set' in the first six code lines, I would like to be group them together, i.e. all the Sets together. But so far have been unable to do so without the script failing.

Note: have used 50MB rather then the 50GB as per original description, makes testing a bit easier.

Related