Option Explicit
Dim WshShell, ThePath, FileSystem, EmptyFolders(100000), x, y, ThePrompt, ReportFile, DeleteFile 
Dim InternetExplorer, Wrongo, DrvLetter, TheDrive, CurDir, Folder, Dummy, RFile, DFile, DeleteIt
Dim WhatToDo, Splash

Set WshShell = WScript.CreateObject("WScript.Shell")
Set FileSystem = Wscript.CreateObject("Scripting.FileSystemObject")
Set InternetExplorer = WScript.CreateObject("InternetExplorer.Application")


'Main Routine

  x = 0
  
  Call SplashScreen
  Call GetThePath
  Call HandleFiles
  Call CheckIfExist
  Call CreateProgressIndicator
  Call FindEmptyFolders(ThePath)
  Call KillProgressIndicator
  Call DisplayEmptyFolders
  Call PromptToDelete

  WScript.Quit

'End Main Routine

Sub GetThePath

  ThePrompt = "Enter the drive or path in which you want to search for empty folders." & vbCrLf & vbCrLf &_
  "For example:  C:\   or   C:\Documents and Settings"
  
  ThePath = InputBox(ThePrompt, "Empty Folder Tracker")
  If ThePath = "" Then WScript.Quit

End Sub 'GetThePath


Sub SplashScreen

  Splash = "Created for TechRepublic      " & vbCrLf &_
  "by Greg Shultz" & vbCrLf &_
  "www.TheWinWiz.com"
      
  Dummy = WshShell.Popup(Splash, 2, "Empty Folder Tracker", 64)

End Sub 'SplashScreen


Sub HandleFiles

  CurDir = WshShell.CurrentDirectory

  RFile = CurDir + "\EmptyFolders.txt"
  DFile = CurDir + "\DeletedFolders.txt"

  ThePrompt = "Previous copies of the report files    " & vbCrLf & vbCrLf &_
    "EmptyFolders.txt" & vbCrLf &_
    "DeletedFolders.txt " & vbCrLf & vbCrLf &_
    "exist in " & CurDir & vbCrLf & vbCrLf &_
    "Is it OK to overwrite them  "

  If (FileSystem.FileExists(RFile)) OR (FileSystem.FileExists(DFile)) Then
    WhatToDo = MsgBox(ThePrompt, 36, "Empty Folder Tracker")
    If WhatToDo = vbNo Then
      Dummy = MsgBox("Empty Folder Tracker will now terminate and you can rename or move the report files.  ", 64, "Empty Folder Tracker")
      WScript.Quit
    End If
  End If

Set ReportFile = FileSystem.CreateTextFile(RFile, True)
Set DeleteFile = FileSystem.CreateTextFile(DFile, True)

End Sub 'HandleFiles


Sub CheckIfExist

  Wrongo = False
  DrvLetter = Left(ThePath, 2)

  Set TheDrive = FileSystem.GetDrive(DrvLetter)
  
  If Not TheDrive.IsReady Then
    Wrongo = "True"
  End If
 
  If Not (FileSystem.DriveExists(DrvLetter)) Then
    Wrongo = True
  Else
    If Not (FileSystem.FolderExists(ThePath)) Then
      Wrongo = True
    End If
  End If  

  If Wrongo = True Then
    Dummy = MsgBox ("Specified drive or path doesn't exist!", 16, "Empty Folder Tracker")
    WScript.Quit
  End If

End Sub 'CheckIfExist


Sub CreateProgressIndicator

  InternetExplorer.Navigate "file://" & CurDir & "\Progress.htm"   
  InternetExplorer.ToolBar = 0
  InternetExplorer.MenuBar = 0
  InternetExplorer.StatusBar = 0
  InternetExplorer.Width=500
  InternetExplorer.Height = 100 
  InternetExplorer.Left = 100
  InternetExplorer.Top = 200
  InternetExplorer.Visible = 1

End Sub 'CreateProgressIndicator


Sub FindEmptyFolders(ThePath)

  DrvLetter = Left(ThePath, 1)
  
  If (ThePath = DrvLetter+":\RECYCLED") OR (ThePath = DrvLetter+":\RECYCLER") OR (ThePath = DrvLetter+":\System Volume Information") Then 
    'Do Nothing
  Else
    If (FileSystem.GetFolder(ThePath).SubFolders.Count = 0) AND (FileSystem.GetFolder(ThePath).Files.Count = 0) Then
      EmptyFolders(x) = ThePath
      x = x + 1
    End If

    For Each Folder In FileSystem.GetFolder(ThePath).Subfolders
      FindEmptyFolders(Folder.Path)
    Next
  End If

End Sub 'FindEmptyFolders 


Sub KillProgressIndicator
  
  InternetExplorer.Quit
  Set InternetExplorer = Nothing
  
End Sub 'KillProgressIndicator


Sub DisplayEmptyFolders

  ThePrompt = "Empty Folder Tracker found " & x & " empty folders on " & ThePath & "  "
  
  Dummy = WshShell.Popup(ThePrompt, 5, "Empty Folder Tracker", 64)

  If x = 0 Then Exit Sub

  ReportFile.WriteLine(String(90, "*"))
  ReportFile.WriteLine("*  " & ThePrompt)
  ReportFile.WriteLine("*  Report compiled on:   " & Now)
  ReportFile.WriteLine(String(90, "*"))
  ReportFile.WriteBlankLines 2

  For y = 0 to x
    ReportFile.WriteLine(EmptyFolders(y))
  Next

  ReportFile.Close
  WshShell.Run "Notepad.exe " & CurDir & "\EmptyFolders.txt", 3, False

End Sub 'DisplayEmptyFolders


Sub PromptToDelete

  If x = 0 Then Exit Sub
  
  ThePrompt = "At this point, you can look through the EmptyFolders.txt file in Notepad " & vbCrLf &_
  "and determine which empty folders you want to delete." & vbCrLf & vbCrLf &_
  "If you wish, Empty Folder Tracker can cycle through the list and "& vbCrLf &_
  "prompt you to delete each individual empty folder" & vbCrLf & vbCrLf &_
  "Do you wish to delete empty folders?"
 
  WScript.Sleep 500

  If vbYes = MsgBox(ThePrompt, 36, "Empty Folder Tracker") Then Call DeleteEmptyFolders
  

End Sub 'PromptToDelete


Sub DeleteEmptyFolders

  DeleteFile.WriteLine(String(90, "*"))
  DeleteFile.WriteLine("*  Empty Folder Tacker deleted the following empty folders:")
  DeleteFile.WriteLine("*  Report compiled on:   " & Now)
  DeleteFile.WriteLine(String(90, "*"))
  DeleteFile.WriteBlankLines 2

  Do
    For y = 0 to x - 1
          
      DeleteIt = MsgBox("Do you want to delete: " & vbCrLf & vbCrLf & vbCrLf &_
      EmptyFolders(y) & vbCrLf & vbCrLf & vbCrLf , 35, "Empty Folder Tracker") 
      
      Select Case DeleteIt
            Case vbYes
              On Error Resume Next
              FileSystem.DeleteFolder (EmptyFolders(y))
              If Err.Number > 0 Then
                Dummy = MsgBox ("Unable to delete this folder!" & vbCrLf &_
                vbCrLf & Err.Description, 16, "Empty Folder Tracker")
                Err.Clear
              Else
                DeleteFile.WriteLine(EmptyFolders(y))
              End If
            Case vbNo
              'Do Nothing
            Case vbCancel
              Exit Do
      End Select
      
      If y = x - 1 Then
        Dummy = MsgBox("You've reached the end of the list. Do you want to cycle thru it again?" & vbCrLf & vbCrLf &_
        "Keep in mind that if you're removing a chain of empty folders, " & vbCrLf &_
        "you'll need to cycle thru the list and remove them one by one." & vbCrLf & vbCrLf &_
        " Do you want to continue?", 68, "Empty Folder Tracker")
        If Dummy = vbNo Then Exit Do
      End If
      
    Next    

    x = 0
    
    FindEmptyFolders(ThePath)
    
  Loop While x > 0
  
  DeleteFile.Close
    
  If vbYes = MsgBox("Do you want to view a report of the folders that you deleted?", 36,"Empty Folder Tracker") Then
    WshShell.Run "Notepad.exe " & CurDir & "\DeletedFolders.txt", 3, False
  End If


End Sub 'DeleteEmptyFolders
