Solved

Delete Folders based on age and log

Posted on 2011-02-23
9
553 Views
Last Modified: 2012-06-21
Hi,

I am looking for a script (preferably VBscript). That will perform the following:

Search through all top level folders on a given path (the path being set as a variable early in the script)

Find all folders that have not been modified or there contents modified in over XX days (with XX being a variable that is easy to change).
Delete folders over XX days
For each folder deleted write the full folder path to a log file and include how old the folder was in days. (E.G. F:\DATA\FOLDERZZ,96 days)

Thanks...
0
Comment
Question by:aideb
  • 3
  • 2
  • 2
  • +2
9 Comments
 
LVL 10

Expert Comment

by:rscottvan
Comment Utility
Here you go...

You can change the "DaysOfRetention" variable and what folder to clean up around line 37.  If you want to clean out files in more than one folder, you can repeat lines 37-40 as many times as you want.
option explicit
on error resume next

'global vars, arrays, constants, objects
Dim oShell : Set oShell = CreateObject("WScript.Shell")
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim oArgs : Set oArgs = WScript.Arguments
Dim oScriptLogFile, sFTPScriptFile, oScriptFile, oScriptLogFolder
Dim oFolder, oFiles, File, sFileName, sFolder, sToday
Dim aDate : aDate = Split(Date(),"/")
Dim sDate : sDate = Right("0" & aDate(0),2) & "_" & Right("0" & aDate(1),2) & "_" & aDate(2)
Dim bDeleted, DaysOfRetention


'constants - these may need to change from customer to customer
'where does this script write it's log?
const ScriptLogFolder = "c:\c:\tools\logrotation\logs"

ReLaunch

'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'***  Main Script  *************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************

'open a file to ScriptLog to
OpenScriptLogFile ScriptLogFolder,"LogRotationLog"

DaysOfRetention = 7
Rotate "c:\tools\logrotation\logs"



'set the number of days
DaysOfRetention = 60
'call the routine to delete files in a folder
Rotate "c:\temp"
		

'close the ScriptLog file
CloseScriptLogFile
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'***  End Main Script  *********************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************









'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'***  Subroutines  *************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************










'*******************************************************************************************************************************************
'***  Zip the web logs  ********************************************************************************************************************
'*******************************************************************************************************************************************
Sub ZipFiles (sFolderToZip)
on error resume next
dim sName


Dim oZipFolder : Set oZipFolder = oFSO.GetFolder (sFolderToZip)
errorcheck "Opened folder " & sFolderToZip & " to clean up files."
'open a collection of files in the folder
Dim oZipFiles : Set oZipFiles = oZipFolder.Files
'loop through the file list and do the work
Dim ZipFile
For each ZipFile in oZipFiles
	If right(ZipFile.Name,3) <> "zip" and DateDiff("D",ZipFile.DateLastModified,Now) > 1 then
		oShell.Run "%comspec% /c 7z a -r -tzip -y -bd """ & ZipFile.Path & ".zip"" " & ZipFile.Path, 0, TRUE
		errorcheck "%comspec% /c 7z a -r -tzip -y -bd """ & ZipFile.Path & ".zip"" " & ZipFile.Path
		ZipFile.Delete
	End If	
Next
End Sub
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************










'*******************************************************************************************************************************************
'***  Rotate the logs  *********************************************************************************************************************
'*******************************************************************************************************************************************
Sub Rotate (sFolderToRotate)
on error resume next
dim sName
Dim oRotateFolder : Set oRotateFolder = oFSO.GetFolder (sFolderToRotate)
errorcheck "Opened folder " & sFolderToRotate & " to clean up files."
'open a collection of files in the folder
Dim oRotateFiles : Set oRotateFiles = oRotateFolder.Files
'loop through the file list and do the work
Dim RotateFile
For each RotateFile in oRotateFiles
	If DateDiff("D",RotateFile.DateLastModified,Now) > DaysOfRetention then
		sName = RotateFile.name
		RotateFile.Delete
		errorcheck "Deleted " & sName
	End If	
Next
End Sub
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************










'*******************************************************************************************************************************************
'***  Relaunch using cscript engine  *******************************************************************************************************
'*******************************************************************************************************************************************
Sub ReLaunch
  Set oShell = CreateObject("WScript.Shell")
  'Determine which script host was used to execute the script
  Dim sScriptHost : sScriptHost = UCase(Right(WScript.FullName, _
  	LEN(WScript.FullName) - InStrRev(WScript.FullName, "\")))

  'If the command line interface wasn't used, relaunch using CSCRIPT
  Dim oArg
  If sScriptHost <> "CSCRIPT.EXE" Then
  	For each oArg in WScript.Arguments
  		sArgString = sArgString & WScript.Arguments(nNodeCounter) & " "
  		nCounter = nCounter + 1
  	Next
  	oShell.Run "CSCRIPT.EXE """ & WScript.ScriptFullName & """ " & sArgString
  	Set oShell = Nothing
  	WScript.Quit
  End If
End Sub
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************









'*******************************************************************************************************************************************
'***  Subroutine to open the Script Log file  **********************************************************************************************
'*******************************************************************************************************************************************
Sub OpenScriptLogFile (sScriptLogPath,sScriptLogHeader)
	On Error Resume Next
	'verify the needed ScriptLog folder exists.  create if necessary
	CreatePath sScriptLogPath
	'split today's date into day and month and year
	Dim sScriptLogFileName : sScriptLogFileName = sScriptLogHeader & "_" & sDate & ".htm"
	'determine if the file already exists (so we know later if we need to append
	'it, or if we need to start from scratch)
	If oFSO.FileExists(sScriptLogPath & "\" & sScriptLogFileName) then Dim bFileExists : bFileExists = True
	err.clear
	'open the ScriptLog file
	Set oScriptLogFile = oFSO.OpenTextFile (sScriptLogPath & "\" & sScriptLogFileName,8,True)
	If err.number <> 0 then
		MsgBox "We were unable to open a ScriptLog file" & vblf & "(" & sScriptLogPath & "\" & sScriptLogFileName & ")" & vblf & " for writing.  Bailing out."& vblf & err.number & ":  " & err.Description
		WScript.Quit
	End If
	'create the header if needed
	If bFileExists <> True then
		oScriptLogFile.WriteLine "<html><body>"
		oScriptLogFile.WriteLine "<b>" & sScriptLogHeader & " - " & Date() & "</b>"
	End If
	'now create the delimiter for this section of the file
	oScriptLogFile.WriteLine "<hr>Script Started - " & Now() & " - <hr>"
	oScriptLogFile.WriteLine "<table border=1 width=100%>"
End Sub
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************










'*******************************************************************************************************************************************
'***  Subroutine to close the ScriptLog file  **********************************************************************************************
'*******************************************************************************************************************************************
Sub CloseScriptLogFile
	'write closing tags and close the ScriptLog
	oScriptLogFile.Writeline "</table>"
	oScriptLogFile.WriteLine "<br><br>"
	oScriptLogFile.WriteLine "<hr>Finished Processing - " & Now() & " - <hr>"
	oScriptLogFile.Close
	Set oScriptLogFile = Nothing
End Sub
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************










'*******************************************************************************************************************************************
'***  Subroutine to write success to the ScriptLog  ****************************************************************************************
'*******************************************************************************************************************************************
Sub SuccessScriptLog (sEvent)
	'write success to ScriptLog file
	oScriptLogFile.Write "<tr><td>" & Now() & "</td>"
	oScriptLogFile.Write "<td>" & sEvent & "</td>"
	oScriptLogFile.WriteLine "<td bgcolor=green><font color=white>SUCCESS</font></td></tr>"
End Sub
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************










'*******************************************************************************************************************************************
'***  Subroutine to write failure to the array  ********************************************************************************************
'*******************************************************************************************************************************************
Sub FailureScriptLog (sEvent,nError,sErrorDescription)
	on error resume next
	'write failure to ScriptLog
	oScriptLogFile.Write "<tr><td>" & Now() & "</td>"
	oScriptLogFile.Write "<td>" & sEvent & "</td>"
	oScriptLogFile.WriteLine "<td bgcolor=red><font color=white>" & nError & ":  " & sErrorDescription & "</font></td></tr>"
End Sub
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************










'*******************************************************************************************************************************************
'***  Subroutine to check error status then write success or failure to the ScriptLog  *****************************************************
'*******************************************************************************************************************************************
Sub ErrorCheck (sEvent)
'check if we had an error
	If err.number = 0 then
		SuccessScriptLog sEvent
	Else
		FailureScriptLog sEvent,err.number,err.Description
	End If
	err.clear
End Sub
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************










'*******************************************************************************************************************************************
'***  Subroutine to create a path in the directory tree  ***********************************************************************************
'*******************************************************************************************************************************************
Sub CreatePath (sPathToCreate)
	on error resume next
	'split the path into an array
	Dim aPathToCreate : aPathToCreate = split(sPathToCreate,"\")
	'start the cumulative path string with the first value from the array
	Dim sCumulativePath : sCumulativePath = aPathToCreate(0)
	'loop through the array elements beginning with the second element,
	'since the first is already part of sCumulativePath
	Dim nLoop : For nLoop = 1 to uBound(aPathToCreate)
		'add the next element to the cumulative path
		sCumulativePath = sCumulativePath & "\" & aPathToCreate(nLoop)
		'check if the folder exists yet
		If Not oFSO.FolderExists (sCumulativePath) then
			'create the folder if needed
			oFSO.CreateFolder sCumulativePath
		End If
	Next
End Sub
'*******************************************************************************************************************************************
'*******************************************************************************************************************************************

Open in new window

0
 
LVL 6

Expert Comment

by:Bxoz
Comment Utility
Hi, take a look to Delen - DELete ENhanced

http://adoxa.110mb.com/delenxrd/

This commande shoud delete all *.bak files that are older that a week in a directory C:\WORK and in its subdirectories

delen c:\work\*.bak /s /[d,-7]

Open in new window

0
 
LVL 12

Expert Comment

by:prashanthd
Comment Utility
Set the sourcedir and retention_days
The script will search all top level folders in sourcedir, delete the folders if lastmodified > retention_days and write a log ex folderpath - 35 days for each folder deleted

On Error Resume Next

sourceDir = "C:\backup\" 'set the directory
retention_days=30 'set retentiondays

Const ForAppending = 8
Set fso = CreateObject("Scripting.FileSystemObject")
Set objTextFile = FSO.OpenTextFile("c:\deleted.log", ForAppending, True)

' Purging of directories older then  retention_days

Dim Dir, subDir, dirFc
Set dir = fso.GetFolder(sourcedir)
Set dirFc = dir.SubFolders
purgedt=Date-(retention_days)

For Each subDir In dirFc
   
    If subDir.DateLastModified < purgedt  Then
        purgedir=destinationDir & subDir.Name
        dayslm=      DateDiff("d",subDir.DateLastModified,Date)      
        Err.Clear
        Set objFolder = fso.GetFolder(purgedir)
        objFolder.Delete
        If Err.Number=0 Then
            objTextFile.WriteLine purgedir & " - " & dayslm & " days"      
        Else
            objTextFile.WriteLine purgedir & " - " & dayslm & " days - ERROR Not deleted"
        End If
    End If            
Next

objTextFile.Close
Set objFolder=Nothing
Set fso=Nothing
0
 
LVL 11

Accepted Solution

by:
dougaug earned 300 total points
Comment Utility
See if this script works for you.

It deletes only folders below the root folder you specify if the folder structure and folder contents have not changed in the interval you want.

Option Explicit

Dim oFS, oFolder, oSubFolder, sRootFolder, oFile, iDays, oLogFile
Const ForAppending = 8

' ------ Set your parameters here ------
sRootFolder = "c:\temp\folder1"
iDays = 5

Function FolderNotModifiedOverDays (aFolder, aDays)
  Dim oSubFolder
 
  FolderNotModifiedOverDays = True

  ' ------ Check if the folder was modified ------
  if DateDiff("d", aFolder.DateLastModified, Date) <= iDays Then
    FolderNotModifiedOverDays = False
    Exit Function
  End if
 
  ' ------ Check if any file in folder was modified ------
  For Each oFile in aFolder.Files
    if DateDiff("d", oFile.DateLastModified, Date) <= iDays Then
       FolderNotModifiedOverDays = False
       Exit Function
    End if
  Next

  ' ------ Check if any subfolder contents was modified ------
  For Each oSubFolder in aFolder.SubFolders
    if not FolderNotModifiedOverDays(oSubFolder, iDays) Then
      FolderNotModifiedOverDays = False
      Exit Function
    End if
  Next
End Function

' ----- Start of execution -----
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFS.GetFolder(sRootFolder)
Set oLogFile = oFS.CreateTextFile("c:\log.txt")

For Each oSubFolder in oFolder.SubFolders
  if FolderNotModifiedOverDays(oSubFolder, iDays) Then
     oLogFile.WriteLine oSubFolder.Path + ", " + CStr(DateDiff("d", oSubFolder.DateLastModified, Date)) + " days"
     oSubFolder.Delete
  End if
Next
oLogFile.Close

Set oFS = Nothing
Set oFolder = Nothing
Set oLogFile = Nothing
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 2

Author Comment

by:aideb
Comment Utility
Hi,

rscottvan - Sorr ythis is for files only - it is folders I need deleted
prashanthd - I tried this script but it kept giving me "Error Not deleted"
dougaug - I tried this script and it worked but each time I ran it the log file was overwritten - could we append instead?
0
 
LVL 12

Assisted Solution

by:prashanthd
prashanthd earned 200 total points
Comment Utility
Please try this code
On Error Resume Next

sourceDir = "C:\backup\" 'set the directory
retention_days=30 'set retentiondays

Const ForAppending = 8
Set fso = CreateObject("Scripting.FileSystemObject")
Set objTextFile = FSO.OpenTextFile("c:\deleted.log", ForAppending, True)

' Purging of directories older then  retention_days

Dim Dir, subDir, dirFc
Set dir = fso.GetFolder(sourcedir)
Set dirFc = dir.SubFolders
purgedt=Date-(retention_days)

For Each subDir In dirFc
   
    If subDir.DateLastModified < purgedt  Then
        purgedir=sourceDir & subDir.Name
        dayslm=      DateDiff("d",subDir.DateLastModified,Date)      
        Err.Clear
        Set objFolder = fso.GetFolder(purgedir)
        WScript.Echo purgedir
        'objFolder.Delete
        If Err.Number=0 Then
            objTextFile.WriteLine purgedir & " - " & dayslm & " days"      
        Else
            objTextFile.WriteLine purgedir & " - " & dayslm & " days - ERROR Not deleted"
        End If
    End If            
Next

objTextFile.Close
Set objFolder=Nothing
Set fso=Nothing

Open in new window

0
 
LVL 12

Expert Comment

by:prashanthd
Comment Utility
Also remove the comment on line 25
'objFolder.Delete remove the " ' "
0
 
LVL 11

Expert Comment

by:dougaug
Comment Utility
Hi,

follow the code that append at the end of log file.

Option Explicit

Dim oFS, oFolder, oSubFolder, sRootFolder, sLogFile, oFile, iDays, oLogFile
Const ForAppending = 8

' ------ Set your parameters here ------
sRootFolder = "c:\temp\folder1"
sLogFile = "c:\temp\log.txt"
iDays = 5

Function FolderNotModifiedOverDays (aFolder, aDays)
  Dim oSubFolder
 
  FolderNotModifiedOverDays = True

  ' ------ Check if the folder was modified ------
  if DateDiff("d", aFolder.DateLastModified, Date) <= iDays Then
    FolderNotModifiedOverDays = False
    Exit Function
  End if
 
  ' ------ Check if any file in folder was modified ------
  For Each oFile in aFolder.Files
    if DateDiff("d", oFile.DateLastModified, Date) <= iDays Then
       FolderNotModifiedOverDays = False
       Exit Function
    End if
  Next

  ' ------ Check if any subfolder contents was modified ------
  For Each oSubFolder in aFolder.SubFolders
    if not FolderNotModifiedOverDays(oSubFolder, iDays) Then
      FolderNotModifiedOverDays = False
      Exit Function
    End if
  Next
End Function

' ----- Start of execution -----
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFS.GetFolder(sRootFolder)
Set oLogFile = oFS.OpenTextFile(sLogFile, ForAppending, True)

For Each oSubFolder in oFolder.SubFolders
  if FolderNotModifiedOverDays(oSubFolder, iDays) Then
     oLogFile.WriteLine oSubFolder.Path + ", " + CStr(DateDiff("d", oSubFolder.DateLastModified, Date)) + " days"
     oSubFolder.Delete
  End if
Next
oLogFile.Close

Set oFS = Nothing
Set oFolder = Nothing
Set oLogFile = Nothing
0
 
LVL 2

Author Closing Comment

by:aideb
Comment Utility
Before I seen your new comments - I managed to work out the issue in the scripts. I used Dougag and prasanthd scripts and took the best bits from both (although used Dougag as the base script)
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Learn about cloud computing and its benefits for small business owners.
ADCs have gained traction within the last decade, largely due to increased demand for legacy load balancing appliances to handle more advanced application delivery requirements and improve application performance.
This tutorial will show how to push an installation of Backup Exec to an additional server in both 2012 and 2014 versions of the software. Click on the Backup Exec button in the upper left corner. From here, select Installation and Licensing, then I…
This tutorial will walk an individual through configuring a drive on a Windows Server 2008 to perform shadow copies in order to quickly recover deleted files and folders. Click on Start and then select Computer to view the available drives on the se…

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now