Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Delete Empty Folders after removing files 1

Status
Not open for further replies.

crahn

IS-IT--Management
Oct 7, 2011
10
US
I had assistance from PHV, in completing most of the script below. It was not part of the original request to delete said folders after removing files. I have tried numerous configurations like what is highlighted below, does anyone know the correct placement and/or code to complete said task? The code below will delete folders if they are already empty, but will not delete after first deleting files inside.

Code:
Set fso = CreateObject("scripting.filesystemobject")
dttoday = Date
tmnow = Time
dtold = DateAdd("yyyy", -7, dttoday)  'files older than 7 years will be deleted
FileName = Year(dttoday) & "." & Month(dttoday) & "." & Day(dttoday) & "-" & Hour(tmnow) & "." & Minute(tmnow) & "." & Second(tmnow) & ".txt"
Set LogFile = fso.OpenTextFile(FileName, 2, True)
LogFile.WriteLine ("Started --" & Date & "  " & Time)
For Each fldname In Array("Z:\test1", "Z:\test2")
  Set fldr = fso.GetFolder(fldname)
  For Each sfldr In fldr.subfolders
    If Left(sfldr.Name, 2) = "20" Then recurse sfldr
  Next
Next
Sub recurse( byref fldr)
dim subfolders,files,folder,file
set subfolders = fldr.subfolders
Set files = fldr.Files
LogFile.WriteLine(fldr.path)
[COLOR=red yellow]If (files.Count = 0 ) Then
fldr.Delete
else[/color]
for each file in files
if file.datecreated < dtold then
LogFile.WriteLine("     DELETED - " & file.name & " Date Created: " & file.datecreated)
on error resume Next
WScript.Echo File
file.delete
end If
Next   
for each folder in subfolders
recurse folder
Next   
set subfolders = nothing
set files = Nothing
end If
End sub
LogFile.WriteLine ("Ended --" & Date & "  " & Time
 
I'd try this instead:
Code:
Sub recurse(ByRef fldr)
Dim subfolders, files, folder, file
Set subfolders = fldr.SubFolders
Set files = fldr.Files
LogFile.WriteLine (fldr.Path)
For Each file In files
  If file.DateCreated < dtold Then
    LogFile.WriteLine ("     DELETED - " & file.Name & " Date Created: " & file.DateCreated)
    On Error Resume Next
    WScript.Echo file
    file.Delete
  End If
Next
For Each folder In subolders
  recurse folder
Next
[!]If (fldr.Files.Count = 0) Then
  fldr.Delete
End If[/!]
Set subfolders = Nothing
Set files = Nothing
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Testing the Script in a live environment. Thank you for all your help!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top