Re: Find Empty Folders

Oh man, I made another syntax error. The very same line that I corrected
last post needs yet another correction. MoreFolder.count should be
MoreFolders.count (the letter s has been added). If it still doesn't work
then comment out the On Error Resume Next statement so that you can catch
any error messages.

"Yogi_Bear_79" <nospam@xxxxxxxxxxx> wrote in message
news:d-ydnbbs8PnRAsbYnZ2dnUVZ_tCdnZ2d@xxxxxxxxxxxxxx
Doesn't seem to work. It runs, but the log is empty minus the standard
first line. I even made a blank folder to see if it found it. Is it
becuase I am selecting a drive and not a directory when it asks?


"Walter Zackery" <please_respond_to@xxxxxxxxx> wrote in message
news:umz3O6GCHHA.3836@xxxxxxxxxxxxxxxxxxxxxxx
I made a slight error. The line that says:

If Folder.files.Count=0 And MoreFolder.count = 0 Then f.WriteLine
selected

should say:

If Folder.files.Count=0 And MoreFolder.count = 0 Then f.WriteLine Folder

"Walter Zackery" <please_respond_to@xxxxxxxxx> wrote in message
news:uxyGJ3GCHHA.4060@xxxxxxxxxxxxxxxxxxxxxxx
Maybe this will work a bit better for you.

Dim oShell, oFolder, fso, selected
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Shell.Application")
If Err Then Quit "Couldn't create Shell.Application object"
Set oFolder = oShell.BrowseForFolder(0, "Select where to search",&H0011
, 17)
Set selected=fso.GetFolder(oFolder.Items.Item.Path)
If selected Is Nothing Then Quit "No valid folder or drive selected"
Set f=fso.CreateTextFile("c:\Empties.txt")
f.WriteLine selected.path & " contains the following folders that are
devoid of files"
f.WriteBlankLines 1
WorkWithSubFolders selected
f.close
Quit ""

Sub WorkWithSubFolders(Folder)
Dim MoreFolders, TempFolder
Set MoreFolders = Folder.SubFolders
If Folder.files.Count=0 And MoreFolder.count = 0 Then f.WriteLine
selected
For Each TempFolder In MoreFolders
WorkWithSubFolders TempFolder
Next
End Sub

Sub Quit(Message)
If Len(Message) Then Msgbox Message
Set fso = Nothing
Set oShell = Nothing
WScript.Quit
End Sub

"Yogi_Bear_79" <nospam@xxxxxxxxxxx> wrote in message
news:cKadnWMX1LHZv8fYnZ2dnUVZ_tOdnZ2d@xxxxxxxxxxxxxx
I have this script that is supposed to find empty folders and write them
to a text file. It works only partially. It actually accurately finds
some empty folders, and others it misses entirely. It also lists some
but not all folders that are empty of files but contain subfolders.

Basically I want to clean up my MP3 drive. WMP leave a lot of garbage
folders. SO The plan is to write to file any folder that is empty or
better yet any folder that doesn't contain an .mp3 or m3u file

Dim oShell, oFolder, oFolderItem, fso, selected, howbad, ColonPos
Set fso = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Shell.Application")
On Error Resume Next
Set oFolder = oShell.BrowseForFolder(0, "Select where to search",&H0011
, ssfDRIVES)
Set oFolderItem = oFolder.Items.Item
Set selected=fso.GetFolder(oFolderItem.Path)
'
howbad = err.number
If howbad <> 0 Then
If howbad = 424 then
oFolder = Null
else
ColonPos = InStr(oFolder.Title, ":")
If ColonPos > 0 Then
selected = Mid(oFolder.Title, ColonPos - 1, 2) & "\"
End If
End If
End If
'
If IsNull(oFolder) Then MsgBox "No valid folder or drive
selected":WScript.Quit
'Set
f=fso.CreateTextFile(fso.GetSpecialFolder(0)&"\desktop\Empties.txt")
Set f=fso.CreateTextFile("c:\Empties.txt")
f.WriteLine selected&" contains the following folders that are devoid
of files"
f.WriteLine " "
'
If selected.SubFolders.Count<>0 Then
WorkWithSubFolders selected
Else
If selected.files.Count=0 Then f.WriteLine selected
End If
'
Sub WorkWithSubFolders(selected)
Dim MoreFolders, TempFolder
If selected.files.Count=0 Then f.WriteLine selected
Set MoreFolders = selected.SubFolders
For Each TempFolder In MoreFolders
WorkWithSubFolders TempFolder
Next
End Sub
Set fso = Nothing
Set oShell = Nothing









.