'Deletes old folders based on age. You must specify a target 'directory and max age. This script looks for these items 'on the command line - The directory is the first argument, 'and the max age is the second argument. Any sub-folders 'in or under the supplied directory that are older than 'the supplied age (in days) will be deleted. 'Written by Eric Phelps http://www.ericphelps.com Option Explicit Dim fs 'As Scripting.FileSystemObject Set fs = CreateObject("Scripting.FileSystemObject") Main Sub Main() Dim strStartingDirectory 'As String Dim dblMaxAge 'As Double 'Create needed objects 'Check for two arguments If WScript.Arguments.Count <> 2 Then Wscript.Echo "USAGE:" & vbCrLf & WScript.ScriptName & " STARTING_DIRECTORY MAX_AGE_IN_DAYS" & vbCrLf & "The starting directory will NOT be deleted, but all subdirectories under it that are OLDER than the max age will be deleted." WScript.Quit 1 End If 'Initialize variables strStartingDirectory = "" dblMaxAge = 0 'Get user-supplied arguments On Error Resume Next strStartingDirectory = Wscript.Arguments(0) dblMaxAge = CDbl(Wscript.Arguments(1)) On Error Goto 0 'Test input data If strStartingDirectory = "" Then WScript.Echo "You must supply a non-empty directory name." WScript.Quit 1 End If strStartingDirectory = fs.GetAbsolutePathName(strStartingDirectory) If strStartingDirectory = "" Then WScript.Echo """" & WScript.Arguments(0) & """ is not a valid directory name." WScript.Quit 1 End If If dblMaxAge < 1 Then WScript.Echo "I was not able to resolve """ & WScript.Arguments(1) & """ as a number greater than 0." Wscript.Quit 1 End If 'Call the recursive folder delete subroutine RemoveOldSubFolders fs.GetFolder(strStartingDirectory), dblMaxAge End Sub Sub RemoveOldSubFolders(objFolder, dblAge) Dim fols, fol On Error Resume Next 'Get each file in turn Set fols = objFolder.SubFolders For Each fol In fols If DateDiff("d", fol.DateLastModified, Now()) > dblAge Then fol.Delete Else RemoveOldSubFolders fol, dblAge End If Next End Sub