VBScript to delete files with limits 1

[crahn]

There are files that go back many years. The files are under a drive with 2 "Main" sub directories (test1 and test2). The test1 and test2 folders have thousands of subfolders with a named date format IE 20010329. Said example subfolder has numerous files and subfolders. I am attempting to create a Script to Delete files/folders older than 7 years to date by creation date. Limits: to not delete "files" in the 2 main directories (test1/test2) but any subfolder with files with created date beyond the 7 yr mark are fair game. Below is a script found and modified (sorry I do not know the creator) with correct/working date function but I cannot get the search folders right. I have attempted to take the script very close to the original state.

' Folder path
const fldname = "Z:\"
set fso = createobject("scripting.filesystemobject")
set fldr = fso.getfolder(fldname)
dttoday = date
tmnow = Time
'Calculate trigger date (change according to your requirements)
dtold = dateadd("yyyy", -7, dttoday) 'files older than 7 years will be deleted

'DateAdd(interval,number,date)
'Interval:
' * yyyy - Year
' * q - Quarter
' * m - Month
' * y - Day of year
' * d - Day
' * w - Weekday
' * ww - Week of year
' * h - Hour
' * n - Minute
' * s - Second
' Log File
Set LogFSO = CreateObject("Scripting.FileSystemObject")
FileName = Year(dttoday)&"."&Month(dttoday)&"."&Day(dttoday)&"-"&Hour(tmnow)&"."&Minute(tmnow)&"."&Second(tmnow)&".txt"
Set LogFile = LogFSO.OpenTextFile(FileName, 2, True)

recurse fldr
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(" DELETING - " & file.name & " Date Created: " & file.datecreated)
on error resume next
'file.delete
WScript.Echo File
end if
next
for each folder in subfolders
recurse folder
next
set subfolders = nothing
set files = nothing
end sub

 

[PHV]

I don't see any reference to "test1" nor "test2" in your script ...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[crahn]

const fldname = "Z:\"" points to the Main directory where test1/test2 reside.

I have tried are;
If Left(folder.Name, 2) = "20" Or left(folder.parentfolder.name, 2) ="20" Then

But I am not sure if I just put it in the wrong location of the script or if the logic is off or what have you

 

[PHV]

= "20"
????

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[crahn]

My thought process was search for 2 characters from left to right for the folder name that starts with 20, since the subfolders where I want to delete subfolders all start with 20 (20010322, 20030322, 20110322). Directory structure if it helps is


z:\test1\20010322\data\files and z:\test1\20010322\files and
z:\test2\20010322\data\files and z:\test2\20010322\files
^ ^ ^ ^ ^
Delete from Carrots forward if date created is over 7 years

 

[PHV]

I'd try something like this (with the recurse procedure you've posted initially):

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)
For Each fldname In Array("Z:\test1", "Z:\test2")
  Set fldr = fso.GetFolder(fldname)
  For Each sfldr In fldr.subfolders
    recurse sfldr
  Next
Next

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[crahn]

This code is searching the correct directories test1 and test2, the only remaining issue that I currently see is it is also finding the folders that do not start with "20". Is this possible? Thank you for taking the time to work on this.

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 = fspenTextFile(FileName, 2, True)
For Each fldname In Array("Z:\test1", "Z:\test2")
Set fldr = fso.GetFolder(fldname)
For Each sfldr In fldr.subfolders
recurse sfldr
Next
Next
recurse fldr
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(" DELETING - " & file.name & " Date Created: " & file.datecreated)
on error resume next
'file.delete
WScript.Echo File
end if
next
for each folder in subfolders
recurse folder
next
set subfolders = nothing
set files = nothing
end sub

 

[PHV]

...
  For Each sfldr In fldr.subfolders
[!]    If Left(sfldr.Name, 2) = "20" Then [/!]recurse sfldr
  Next
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[crahn]

Thank you for the fast responses and sorry for my late response.

The script is almost complete. 1 issue discovered is files that reside in the test1 & test2 folder are being deleted. 2nd issue found is deleting the folders once they are empty.

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
recurse fldr
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
file.delete
'WScript.Echo File
end If
Next   
for each folder in subfolders 
recurse folder
Next   
set subfolders = nothing
set files = Nothing
end sub
LogFile.WriteLine ("Ended --" & Date & "  " & Time)

I attempted to add logic as the following to remove the empty folders and have had mixed results. If there is a subfolder under "20000322" (or similarly named) it will be deleted but not the "20000322" folder itself.

If (fldr.Files.Count = 0) Then
			LogFile.WriteLine ("Deleted " & fldr.Name )
			fldr.Delete True

 

[PHV]

files that reside in the test1 & test2 folder are being deleted
Really ?

 

[crahn]

Yes, I just tested again. It is deleting files from the second "test2" directory but is not on the first "test1".

 

[PHV]

Comment out this line !
recurse fldr

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[crahn]

Perfect, that resolved the issue of deleting the files residing in the test1 and test2 folders.

 

[crahn]

Current script is as follows, it will delete a folder if it is "already" empty but will not remove files then delete the folder. Do I just have it in the wrong location? This was not part of the original request, would it be better if I create a new topic?

thanks again

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

 

[PHV]

This was not part of the original request, would it be better if I create a new topic
Yes.