Re: Find Empty Folders

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

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



.

Relevant Pages

  • Re: Multi-folder updates
    ... > set fso = createobject ... > Call CopyThemAll(SourceFolder, TargetFolder) ... > "Steven Burn" wrote in message ... >> I have 3 folders in the root of my site; ...
    (microsoft.public.inetserver.asp.general)
  • Re: Multi-folder updates
    ... > set fso = createobject ... > Call CopyThemAll(SourceFolder, TargetFolder) ... > "Steven Burn" wrote in message ... >> I have 3 folders in the root of my site; ...
    (microsoft.public.inetserver.asp.general)
  • Re: Copy Excel files from sub-folders but restricted to one level
    ... folders 1 level down, which may have been added too or deleted. ... Dim strFromPath As String ... Dim strToPath As String ... Set Fso = CreateObject ...
    (microsoft.public.excel.programming)
  • Re: Delete Folder Script - error: path not found
    ... Dim i, fso, f, f1, s, sf, BasePath, CalcResult, fNameArray ... I double click on the following script and there is no error ... Example of the folders are ... Set fso = CreateObject ...
    (microsoft.public.windowsxp.help_and_support)
  • Re: Programs Installed
    ... Set fso = CreateObject ... Set oShell = WScript.CreateObject ... Set newf = fso.createtextfile ... For each fol in fc ...
    (microsoft.public.scripting.vbscript)