# 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"

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
DeleteOldFiles strPath, OlderThanDate

Loop

Set TextStream = nothing
Else
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

###### Who is Participating?

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"

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
DeleteOldFiles strPath, OlderThanDate
RemoveEmptyFolders strPath
Loop

Set TextStream = nothing
Else
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
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

0

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"

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
DeleteOldFiles strPath, OlderThanDate
RemoveEmptyFolders strPath
Loop

Set TextStream = nothing
Else
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

0

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
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

0

Commented:
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

Author 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

Commented:
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

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

Commented:
>> 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

Author Commented:
How do I call his sub from the within my original code?
0

Author 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

Commented:
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

Author 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

Author 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

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

Author 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

Author 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