Wednesday, March 3, 2010

vbscript for deleting 2 week old files in 44 separate folders

Option Explicit

Dim fso, dTwoWeeksAgo

dTwoWeeksAgo = Date() - 14
wscript.echo dTwoWeeksAgo
Set fso = CreateObject("Scripting.FileSystemObject")

'DirWalk("C:\")               ' repeat this subroutine call with a different path to process more paths
'DirWalk("F:\users\data\")   ' like this.
'DirWalk("\\phobos\E$\ee\")  ' and/or like this.

DirWalk("C:\tmp\test\hmm")

Sub DirWalk(parmPath)
Dim oSubDir, oSubFolder, oFile, n

   On Error Resume Next         ' We'll handle any errors ourself, thank you very much

   Set oSubFolder = fso.getfolder(parmPath)

   For Each oFile In oSubFolder.Files   ' look in the current dir
      If Err.Number <> 0 Then   ' if we got an error, just skip this entry
         Err.Clear
      ElseIf oFile.DateLastModified < dTwoWeeksAgo Then
         Wscript.Echo "about to delete " & oFile.Path
      '''uncomment the next line when you are satisfied this script works properly
      '''fso.DeleteFile oFile.Path, True
      End If
   Next

   For Each oSubDir In oSubFolder.Subfolders
      DirWalk oSubDir.Path      ' recurse the DirWalk sub with the subdir paths
   Next

   On Error Goto 0              ' Resume letting system handle errors.

   ' Removing a empty folder.
   ' Commenting out following block if you prefer to keep these empty folders.
   If fso.getfolder(parmPath).SubFolders.Count = 0 AND fso.getfolder(parmPath).Files.Count = 0 Then
      fso.DeleteFolder(parmPath)
   End If

End Sub

No comments: