Solved

Need a script to loop through folders to look for a folder called "common" and delete all files older than 45 days with the exception of certain extensions and log the activity in a log file.

Posted on 2009-07-13
16
660 Views
Last Modified: 2013-12-04
I am looking for a script that will look in a folder that is like a "users" folder.  It needs to find all the directories named "common" under these user folders and delete all the files in this directory and all the subdirectories older than 45 days.  We need it to create a log file for each day this ran with all the files deleted listed.
0
Comment
Question by:kerryhill
  • 10
  • 5
16 Comments
 
LVL 5

Expert Comment

by:boowhup
ID: 24846195
This script searches a folder (strBaseFolder) and all subfolders for "common" in the name (you can define this in strSearchFile). It then tries to delete very file in that folder (but not subfolders) and if successfully deleted writes to a logfile.
strSearchFile = "common"

strBaseFolder = "d:\"

strdate = year(now) & month(now) & day(now)

strLogFile = ".\log-" & strdate & ".csv"

intOldDate = 45

'========================
 

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objBaseFolder = objFSO.GetFolder(strBaseFolder)

WriteToTxt "Time,Filename(Short),Filename(Full)"

ProcessFolder(objBaseFolder)

'=========================
 

Sub ProcessFolder(objFolder)

	On Error Resume Next

	For Each objSubFolder in objFolder.SubFolders

		For Each strExtension in arrDirectoryExtensions 

			if Instr(objSubFolder.Name,strSearchFile) then

				DeleteFiles(objSubFolder)

			end if

		Next

		ProcessFolder(objSubFolder)

	Next

	

	On Error Goto 0

End Sub
 

Function DeleteFiles(objFolder)

	For	Each objFile in objFolder.Files

		On Error Resume Next

		objFile.Delete

		if Err.Number = 0 then

			WriteToTxt GetDetails(objFile)

		end if

		On error Goto 0

	Next

End Function

Open in new window

0
 

Author Comment

by:kerryhill
ID: 24851243
Thanks, will this continue to look for subfolders named Common after it finds the first one?  There will be multiple "common" folders.
0
 
LVL 5

Expert Comment

by:boowhup
ID: 24858016
yes, it will go through every sub folder from the "base" (root) folder , and work against each "common" found , then keep going. One thing I should mention, it looks for the word "common" in the name, so it would work against "xxcommonxx" as well as "common". I can change if necessary.
0
 

Author Comment

by:kerryhill
ID: 24861272
Great, is there a way to make is delete files over 45 days in the common folder recursively?
0
 
LVL 14

Expert Comment

by:robincm
ID: 24867492
you'd need to define what you mean by "over 45 days". 45 days since when? Creation date? Last Accessed date? Last Modified date?

Just need to tweak the delete function as follows.

Swap objFile.DateLastModified for objFile.DateCreated or objFile.DateLastAccessed as appropriate.

The script above uses a sub called WriteToTxt to write the log but the code for that isn't supplied. You can just knock something basic up using objFile.WriteLine (as shown). Just make sure you set sLogFile at the top of the script.


Function DeleteFiles(objFolder)

	For	Each objFile in objFolder.Files

		On Error Resume Next

		If (Now() - objFile.DateLastModified) > intOldDate Then

			objFile.Delete

		End If

		if Err.Number = 0 then

			WriteToTxt GetDetails(objFile)

		end if

		On error Goto 0

	Next

End Function
 

Dim sLogFile

sLogFile = "C:\scripts\basiclog.txt"
 

Sub WriteToTxt(sText)
 

	Dim oFSO, oFile

	Set oFSO = CreateObject("Scripting.FileSystemObject")

	Set oFile = oFSO.OpenTextFile(sLogFile,8,True)

	oFile.WriteLine Now()&" "&sText
 

End Sub	

Open in new window

0
 

Author Comment

by:kerryhill
ID: 24874331
I apologize that it is taking a little while to respond, I am a little slow when it comes to asp script.  Thank you very much for the responses, I should be able to respond tomorrow about this.
0
 
LVL 5

Expert Comment

by:boowhup
ID: 24875501
well spotted robincm, I think I pasted in a WIP.  it should have been this...

And robin's comment re changing from datelast modified / date last accessed is something to think about. Although If I remember correctly datelastmodifed is always later than datecreated and dateaccessed will be updated to now() as soon as it's touched by the filesystemobject??

I would leave it as datelastmodified, as that is the one that shows in windows explorer, and the one in a dos dir command - so would be the one you would manually compare against when testing the script.


strSearchFile = "common"

strBaseFolder = "d:\"

strdate = year(now) & month(now) & day(now)

strLogFile = ".\log-" & strdate & ".csv"

intOldDate = 45

'========================
 

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objBaseFolder = objFSO.GetFolder(strBaseFolder)

WriteToTxt "Time,Filename(Short),Filename(Full)"

ProcessFolder(objBaseFolder)

'=========================
 

Sub ProcessFolder(objFolder)

	On Error Resume Next

	For Each objSubFolder in objFolder.SubFolders

		For Each strExtension in arrDirectoryExtensions 

			if Instr(objSubFolder.Name,strSearchFile) then

				DeleteFiles(objSubFolder)

			end if

		Next

		ProcessFolder(objSubFolder)

	Next

	

	On Error Goto 0

End Sub
 

Function DeleteFiles(objFolder)

	For	Each objFile in objFolder.Files

		On Error Resume Next

		If (Now() - objFile.DateLastModified) > intOldDate Then

			objFile.Delete

		End If

		if Err.Number = 0 then

			WriteToTxt GetDetails(objFile)

		end if

		On error Goto 0

	Next

End Function
 

Function GetDetails(objF)

	GetDetails = objF.Path & "," & GetDetails 

	GetDetails = objF.Name & "," & GetDetails 	

End Function
 

Sub WriteToTxt(strWrite)

	'Appends lines to Log File

	Set FSO = CreateObject("Scripting.FileSystemObject")

	Set objOutputFile = FSO.OpenTextFile(strLogFile, 8, True)

	objOutputFile.WriteLine(Now & "," & strWrite)

	objOutputFile.close

End Sub

Open in new window

0
 

Author Comment

by:kerryhill
ID: 24882799
Ok, this is looking very nice, thank you, I may actually set it to createddate in the end because people will go in and modify stuff just to avoid it being deleted -- yeah, they would actually do that.  The other thing that happens is they bury the files in folders, is there a way for it to perform the delete recursively from the "common" folder?
0
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

 

Author Comment

by:kerryhill
ID: 24883392
Unfortunately, my scripting skills are truly non-existant, something I need to pick up, but is it already doing the recursive bit?  Is that this bit:  For Each objSubFolder in objFolder.SubFolders?
0
 
LVL 5

Expert Comment

by:boowhup
ID: 24885565
At the moment it will only delete the folders in the "common" folder, not any files in subfolders, but it does check all subfolders for another common folder (thats the recursive part). If you want it to delete every file under the common folder, includng all files found in the subfolders (and their subfolders etc ) I can change it to do that. Do you want it to leave the empty subfolders behind, or delete those too?

0
 

Author Comment

by:kerryhill
ID: 24898769
Yes, I want it to leave the empty folders behind, but any folders under the common folder, it should delete all the files older than 45 days.
0
 

Author Comment

by:kerryhill
ID: 24955116
Boowhup,

I have tested this, and it works but I need it to delete the files recursively under each "common" folder it finds.  Is this possible?

0
 
LVL 5

Accepted Solution

by:
boowhup earned 500 total points
ID: 24966185
Sorry I have been a bit sick and overlooked this, hope you haven't been waiting too long.

I've changed the ProcessFolder subroutine to this....

Sub ProcessFolder(objFolder)
      On Error Resume Next
      For Each objSubFolder in objFolder.SubFolders
            if Instr(objSubFolder.Path,strSearchFile) then
                        DeleteFiles(objSubFolder)
                  end if
            ProcessFolder(objSubFolder)
      Next
      On Error Goto 0
End Sub

Have attached a full copy of the new code. Basically it's going to look for the word "common" in the whole path of the folder. (ie it will delete files from the following folders....)

c:\Username\common\
c:\username\common\subfolder1
c:\Username\common\subfolder2
c:\username\common\subfolder2\anothersubfolder

etc

This should work as you want, but best to do some testing 1st as always :D
strSearchFile = "common"

strBaseFolder = "d:\"

strdate = year(now) & month(now) & day(now)

strLogFile = ".\log-" & strdate & ".csv"

intOldDate = 45

'========================

 

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objBaseFolder = objFSO.GetFolder(strBaseFolder)

WriteToTxt "Time,Filename(Short),Filename(Full)"

ProcessFolder(objBaseFolder)

'=========================

 

Sub ProcessFolder(objFolder)

	On Error Resume Next

	For Each objSubFolder in objFolder.SubFolders

		if Instr(objSubFolder.Path,strSearchFile) then

				DeleteFiles(objSubFolder)

			end if

		ProcessFolder(objSubFolder)

	Next

	On Error Goto 0

End Sub

 

Function DeleteFiles(objFolder)

	For	Each objFile in objFolder.Files

		On Error Resume Next

		If (Now() - objFile.DateLastModified) > intOldDate Then

			objFile.Delete

		End If

		if Err.Number = 0 then

			WriteToTxt GetDetails(objFile)

		end if

		On error Goto 0

	Next

End Function

 

Function GetDetails(objF)

	GetDetails = objF.Path & "," & GetDetails 

	GetDetails = objF.Name & "," & GetDetails 	

End Function

 

Sub WriteToTxt(strWrite)

	'Appends lines to Log File

	Set FSO = CreateObject("Scripting.FileSystemObject")

	Set objOutputFile = FSO.OpenTextFile(strLogFile, 8, True)

	objOutputFile.WriteLine(Now & "," & strWrite)

	objOutputFile.close

End Sub

Open in new window

0
 

Author Comment

by:kerryhill
ID: 24966475
Thank you so much, I hope you are feeling ok.  Don't feel bad at all about the time, you are helping me.  I just get the emails about needing to stay in touch, so I try to update my questions every few days.  I will test this tomorrow and get back to you.  Thanks again for all of your help, you have no idea how helpful this will be.
0
 

Author Comment

by:kerryhill
ID: 25063134
This works great!  Thank you very much!
0
 

Author Closing Comment

by:kerryhill
ID: 31603116
Thank you very much this works!
0

Featured Post

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

Join & Write a Comment

Suggested Solutions

You may have already been in the need to update a whole folder stucture using a script. Robocopy does it well and even provides a list of non-updated files in a log (if asked to). Generally those files that were locked by a user or a process by the …
Whether you've completed a degree in computer sciences or you're a self-taught programmer, writing your first lines of code in the real world is always a challenge. Here are some of the most common pitfalls for new programmers.
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

706 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

16 Experts available now in Live!

Get 1:1 Help Now