DeleteEmptyFolders

' !!! !!! !!! !!! !!! WARNING !!! !!! !!! !!! !!!
' This is dangerous code, if not done right, it will delete files from your hard drive
' until it runs into an error from trying to delete something that can't be deleted
' !!! !!! !!! !!! !!! WARNING !!! !!! !!! !!! !!!

' This is supposed to only delete empty folders that contain no files

Sub DeleteEmptyFolders()
Dim FSO As Object, FSF As Object, FSS As Object, SF As Object

  Set FSO = CreateObject("Scripting.FileSystemObject")
  RecurseFolders "%START-PATH%" ' replace this with your target for assassination.
End Sub


Function RecurseFolders(FolderPath As String) As Long
Dim FSO As Object, FSF As Object, FSS As Object, SF As Object, Results As Long

  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set FSF = FSO.GetFolder(FolderPath)

  Set FSS = FSF.SubFolders
  If (FSS.Count = 0) Then
    Results = FSF.Files.Count
  Else
    For Each SF In FSS
      Results = RecurseFolders(FolderPath & "\" & SF.Name)
      If (Results = 0) Then
        FSO.DeleteFolder FolderPath & "\" & SF.Name
        Results = 0
      Else
        Exit For
      End If
    Next
  End If

  RecurseFolders = Results
End Function