Wednesday, January 26, 2011

Recursively Delete Old Files and Empty Folders

With a slight twist: The recursion to delete empty folders ignores folders with a name that begins with a tilde "~". You can modify the character or pattern to suit your demented whims.

Const maxAge = 30
Const testMode = True

Sub RecursiveDeleteByAge(ByVal strDirectory, maxAge)
 Dim objFolder, objSubFolder, objFile
 Set objFolder = objFSO.GetFolder(strDirectory)
 For Each objFile in objFolder.Files
  dlm = objFile.DateLastModified
  If DateDiff("d", dlm, Now) > maxAge Then
   wscript.echo "Deleting:" & objFile.Path
   If Not testMode = True Then
    objFile.Delete
   End If
   Exit For
  End If
 Next 
 For Each objSubFolder in objFolder.SubFolders
  RecursiveDeleteByAge objSubFolder.Path, maxAge
 Next
End Sub


Sub RecursiveDeleteEmptyFolders(ByVal strDirectory)
 Dim objFolder, objSubFolder
 Set objFolder = objFSO.GetFolder(strDirectory)
 
 If objFolder.Files.Count = 0 Then
  If objFolder.SubFolders.Count = 0 Then
   ' no sub-folders beneath this folder...
   If Left(objFolder.Name,1) <> "~" Then
    wscript.echo "deleting " & objFolder.Path
    If Not testMode = True Then
     objFolder.Delete
    End If
   End If
  Else
   For Each objSubFolder in objFolder.SubFolders
    RecursiveDeleteEmptyFolders objSubFolder.Path
   Next
  End If
 Else
  wscript.echo "folder is not empty"
  For Each objSubFolder in objFolder.SubFolders
   RecursiveDeleteEmptyFolders objSubFolder.Path
  Next
 End If
 
End Sub

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

RecursiveDeleteByAge "d:\downloads", maxAge
RecursiveDeleteEmptyFolders "d:\downloads"

wscript.echo "finished!"

2 comments:

  1. Thx for the handy script!

    Underneath version of 'RecursiveDeleteEmptyFolders' is slightly simpler, but does (as far as I can see and have tested) the same job.

    Const testMode = True

    Sub RecursiveDeleteEmptyFolders(ByVal strDirectory)
    Dim objFolder, objSubFolder
    Set objFolder = objFSO.GetFolder(strDirectory)

    For Each objSubFolder in objFolder.SubFolders
    RecursiveDeleteEmptyFolders objSubFolder.Path
    Next


    If objFolder.Files.Count = 0 Then
    If objFolder.SubFolders.Count = 0 Then
    ' no sub-folders beneath this folder...
    If Left(objFolder.Name,1) <> "~" Then
    wscript.echo "deleting " & objFolder.Path
    If Not testMode = True Then
    objFolder.Delete
    End If
    End If
    End If
    End If

    End Sub

    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    RecursiveDeleteEmptyFolders "d:\downloads"

    wscript.echo "finished!"

    ReplyDelete
    Replies
    1. KISS :-)

      Set folderCollection = folder.SubFolders
      For Each subFolder In folderCollection
      'Looping through all subfolders...
      DeleteOldFiles subFolder.Path, BeforeDate
      If 0 = subFolder.Files.Count And 0 = subFolder.SubFolders.Count Then
      iFolderCount = iFolderCount + 1
      WScript.Echo "...Deleting FOLDER..." & """" & subFolder.Path & """"
      subFolder.Delete True
      End If
      Next

      Delete