Need VB Script to delete empty folders and subfolders

I need the script below to delete any empty folders and subfolders, after it goes through and deletes old files as defined.  I need someone to actually add the folder delete code into the script so that I do not waste time trying to figure out how to implement it into the existing code :)
Dim fso, startFolder, OlderThanDate
Dim strFilename, strPath
 
Set fso = CreateObject("Scripting.FileSystemObject")
strFilename = "urgent.txt"
OlderThanDate = DateAdd("d", -60, Date)  ' 60 days (adjust as necessary)
 
      set objFSO = CreateObject("Scripting.FileSystemObject")
      if objFSO.FileExists(strFilename) Then
            set objFile = objFSO.GetFile(strFilename)
            Dim TextStream
            Set TextStream = objFile.OpenAsTextStream(1,0)
            Dim Line,i
 
            Do While Not TextStream.AtEndOfStream
                  strPath = trim(TextStream.readline)
                  DeleteOldFiles strPath, OlderThanDate
		  
            Loop
 
            Set TextStream = nothing
      Else
            Msgbox "Input File not found"
      End If
Msgbox "Old Backup files have been deleted...Done !!"
 
Function DeleteOldFiles(folderName, BeforeDate)
   Dim folder, file, fileCollection, folderCollection, subFolder
 
   Set folder = fso.GetFolder(folderName)
   Set fileCollection = folder.Files
   For Each file In fileCollection
      If file.DateLastModified < BeforeDate Then
         fso.DeleteFile(file.Path)
      End If
   Next
 
    Set folderCollection = folder.SubFolders
    For Each subFolder In folderCollection
       DeleteOldFiles subFolder.Path, BeforeDate
    Next
 
End Function

Open in new window

murrycAsked:
Who is Participating?
 
Robberbaron (robr)Connect With a Mentor Commented:
sorry my code had typos from where i cut and pasted.

tested version attached.  it does delete the top level folder as well if all belw are now empty.

tested with new files and empty folder with spaces in filename.

Dim fso, startFolder, OlderThanDate
Dim strFilename, strPath
 
Set fso = CreateObject("Scripting.FileSystemObject")
strFilename = "c:\work\ee\urgent.txt"
OlderThanDate = DateAdd("d", -60, Date)  ' 60 days (adjust as necessary)'
 
      set objFSO = CreateObject("Scripting.FileSystemObject")
      if objFSO.FileExists(strFilename) Then
            set objFile = objFSO.GetFile(strFilename)
            Dim TextStream
            Set TextStream = objFile.OpenAsTextStream(1,0)
            Dim Line,i
 
            Do While Not TextStream.AtEndOfStream
                  strPath = trim(TextStream.readline)
                  DeleteOldFiles strPath, OlderThanDate
                  RemoveEmptyFolders strPath
            Loop
 
            Set TextStream = nothing
      Else
            Msgbox "Input File not found"
      End If
Msgbox "Old Backup files have been deleted...Done !!"
 
Function DeleteOldFiles(folderName, BeforeDate)
   Dim folder, file, fileCollection, folderCollection, subFolder
 
   Set folder = fso.GetFolder(folderName)
   Set fileCollection = folder.Files
   For Each file In fileCollection
      If file.DateLastModified < BeforeDate Then
         fso.DeleteFile(file.Path)
      End If
   Next
 
    Set folderCollection = folder.SubFolders
    For Each subFolder In folderCollection
       DeleteOldFiles subFolder.Path, BeforeDate
    Next
 
End Function
 
'====================
Sub RemoveEmptyFolders(sFolderName)
 
        Dim objFolder, objSubFolders, objFiles
        Dim xFolder, xFile
        Dim ret
 
        'On Error Resume Next'
 
        Set objFolder = fso.GetFolder(sFolderName)
        Set objSubFolders = objFolder.SubFolders
        Set objFiles = objFolder.Files
 
 
        'count files'
        iTotFiles=iTotFiles + objFiles.count
        'set to remove readonly
        Const READONLY = 1
        For Each xFile In objFiles
                xFile.Attributes = xFile.Attributes And Not READONLY
        Next
 
        For Each xFolder In objSubFolders
           xFolder.Attributes = xFolder.Attributes And Not READONLY
           RemoveEmptyFolders (xFolder.Path)
        Next
 
        'count directories found'
        itotdirs=itotdirs+1
        
        ' If the folder is empty then delete the folder.'
        If objFiles.Count <= 0 and objSubFolders.count <= 0 Then
                iDelDirs=iDelDirs+1
                fso.DeleteFolder sFolderName, True
        End If
    
End Sub

Open in new window

0
 
RobSampsonConnect With a Mentor Commented:
Hi there.  Try this on a test folder structre....

Regards,

Rob.
Dim fso, startFolder, OlderThanDate
Dim strFilename, strPath
 
Set fso = CreateObject("Scripting.FileSystemObject")
strFilename = "urgent.txt"
OlderThanDate = DateAdd("d", -60, Date)  ' 60 days (adjust as necessary)
 
      set objFSO = CreateObject("Scripting.FileSystemObject")
      if objFSO.FileExists(strFilename) Then
            set objFile = objFSO.GetFile(strFilename)
            Dim TextStream
            Set TextStream = objFile.OpenAsTextStream(1,0)
            Dim Line,i
 
            Do While Not TextStream.AtEndOfStream
                  strPath = trim(TextStream.readline)
                  DeleteOldFiles strPath, OlderThanDate
                  RemoveEmptyFolders strPath
            Loop
 
            Set TextStream = nothing
      Else
            Msgbox "Input File not found"
      End If
Msgbox "Old Backup files have been deleted...Done !!"
 
Function DeleteOldFiles(folderName, BeforeDate)
   Dim folder, file, fileCollection, folderCollection, subFolder
 
   Set folder = fso.GetFolder(folderName)
   Set fileCollection = folder.Files
   For Each file In fileCollection
      If file.DateLastModified < BeforeDate Then
         fso.DeleteFile(file.Path)
      End If
   Next
 
    Set folderCollection = folder.SubFolders
    For Each subFolder In folderCollection
       DeleteOldFiles subFolder.Path, BeforeDate
    Next
 
End Function
 
Sub RemoveEmptyFolders(strFolder)
	Set objShell = CreateObject("WScript.Shell")
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	strFolder = objFSO.GetFolder(strFolder).ShortPath
	strCommand = "cmd /c dir " & strFolder & " /ad/b/s | sort /r > C:\EMPTYFOLDERS.TXT"
	objShell.Run strCommand, 0, True
	strCommand = "cmd /c for /f ""tokens=*"" %i in (C:\EMPTYFOLDERS.TXT) do rd /q %i"
	objShell.Run strCommand, 0, True
	objFSO.DeleteFile "C:\EMPTYFOLDERS.TXT", True
End Sub

Open in new window

0
 
Robberbaron (robr)Commented:
heres my version of RemoveEmptyFolders. currently in use.

doesnt use shell. no idea if it is slower.

assumes FSO set as fs in main code.

'====================
Sub RemoveEmptyFolders(sFolderName)
 
	Dim objFolder, objSubFolders, objFiles
	Dim xFolder, xFile
	Dim ret
 
	On Error Resume Next
 
	Set objFolder = fso.GetFolder(sFolderName)
	Set objSubFolders = objFolder.SubFolders
	Set objFiles = objFolder.Files
 
 
	'count files
	iTotFiles=iTotFiles + objFiles.count
	'set to remove readonly
	Const READONLY = 1
	For Each xFile In objFiles
		xFile.Attributes = File.Attributes And Not READONLY
	Next
 
	For Each xFolder In objSubFolders
	   xFolder.Attributes = xFolder.Attributes And Not READONLY
 	   ScanFolder (xFolder.Path)
	Next
 
	'count directories found
	itotdirs=itotdirs+1
	
	' If the folder is empty then delete the folder.
	If objFiles.Count <= 0 and objSubFolders.count <= 0 Then
		iDelDirs=iDelDirs+1
	        fs.DeleteFolder sFolderName, True
	End If
    
End Sub

Open in new window

0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
RobSampsonCommented:
Hi robberbaron, my feeling is that that would be slower, a) because it uses the FileSystemObject (which can be slow for large file operations) and b) because it scans folders from the root down...

Also, because it scans from the root down, if it deletes a folder at the end of the tree, it may not delete its parent folder if that then becomes empty, because it has already scanned that folder.

By using the DIR command, I have sorted the results in reverse order, then just used RD to attempt to delete every folder, which fails if the folder contains anything.

Regards,

Rob.
0
 
murrycAuthor Commented:
Rob...I created a test folder called 'Folder' and created a couple of empty folders inside of the root of that folder.  I ran the script against c:\Folder\ and it did not delete the empty folders in the root of Folder.  
0
 
RobSampsonCommented:
Hi, that's strange.  The script works for me when I place a valid folder (local folder path, I haven't tested with a UNC path), into urgent.txt

Also, you must have write privileges to the root of C drive, which is where the EMPTYFOLDERS.txt file gets created.  If you do not have rights to that, you can change the C:\EMPTYFOLDERS.txt references to something that you will have access to.

Regards,

Rob.
0
 
Robberbaron (robr)Commented:
it wouldnt surprise me if my routine is slower. Though a Question i asked some time ago proved that creating the FSO at main script level and reusing was much faster than creating new objects.

but the routine is recursive, starting at whatever level you call it with. It goes all the way to the bottom of the tree and then starts deleting folders with FileCount=0. So it certainly deletes full tree of empty folders.

It is in use to cleanup project folders prior to archiving them.
0
 
RobSampsonCommented:
>> It goes all the way to the bottom of the tree and then starts deleting folders with FileCount=0

Cool...I haven't tested it, and must be reading it wrong....murryc, give robberbaron's code a go, it might work better for you.  I will endeavor to test it when I can, and add it to my code library ;-)

Thanks.

Regards,

Rob.
0
 
murrycAuthor Commented:
How do I call his sub from the within my original code?
0
 
murrycAuthor Commented:
It looks like robber's sub is the same name as your's, so I just inserted his sub within my script.  I run it but it does not delete any empty folders.

Just to make sure we are all on the same page, here is what I am doing to test it.

I enter the following into the urgent.txt file.
c:\Folder\

I then create a new folder within the c:\Folder\ location - c:\Folder\New Folder.  There is nothing in the folder and I am running the script on the local computer and I have full rights to the folder and contents.  I run the script, using either sub, and the 'New Folder' does not get deleted.  I do not receive any error messages from the script.
0
 
RobSampsonCommented:
Hmm, OK, if you comment out this line from my code:
objFSO.DeleteFile "C:\EMPTYFOLDERS.TXT", True

then after you run the script, does the EMPTYFOLDERS.txt file get created, and does it have the folders listed in it?

Regards,

Rob.
0
 
murrycAuthor Commented:
It seems to work on folders that contain no spaces in their name.  I did what you requested and it created the text file and listed the folder path in the list, but it did not delete the folder.

I then renamed the folder with no spaces in its name and it deleted as expected.
0
 
murrycAuthor Commented:
Works Great!  I need one last change.  I get a script error if the root folder is completely empty, which might happen when the script is run.  Can you have it not error, but just exit if the root is completely empty?
0
 
Robberbaron (robr)Commented:
do you mean the root of the drive or the strPath read from the urgent.txt file ?  I dont get the error for the later situation.

if the error occurs in the RemoveEmptyFolders function, remove the comment mark from On Error Resume Next.

i had the on error operational in my original code, but commented it out for testing.

The On Error  ensures that the script keeps working if you dont have rights to delete folder.
0
 
murrycAuthor Commented:
It was the strPath root folder location.  I removed the comment marks and it works perfectly!

Great Work to both of you!  I have another script question coming up really soon.  I hope either of you get to answer it also.
0
 
murrycAuthor Commented:
Here is my new script need.  You guys up for another challenge?

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24374239.html
0
All Courses

From novice to tech pro — start learning today.