Modify Deletion script to not be recursive 1

[Icarus2010]

Hi, this piece of script looks at a directory and removes files with a TXT or TMP extension that are older than 4 days. My problem is from where the script is ran, it also searches sub folders. I only want it to check the directory the vbs script is being executed from.

Can someone help me modify it please ?







'==========================================================================
'
'
' TITLE : HA4000_LogPurge_v0.1
'
' AUTHOR : Mike Chandler
' DATE : 23/06/2010
' VERSION : 0.1
'
' DESCRIPTION : Delete connection Monitor log files with the extensions BAK,TXT
' older than 4 days. Script must be run localy. Will only delete files that are older
' than 4 days from the current time the script is ran. Deletes files from
' the current directory. i.e Same directory the script is located.
'
'==========================================================================

'Current Date minus 4 days
dtmDate = Date - 4
Dim CurDir

strDay = Day(dtmDate)
If len(strDay) < 2 Then
strDay = "0" & strDay
End If

strMonth = Month(dtmDate)
If Len(strMonth) < 2 Then
strMonth = "0" & strMonth
End If

strYear = Year(dtmDate)

strTargetDate = strYear & strMonth & strDay

FolderCount = 0
DeletedCount = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWSH = CreateObject("WScript.Shell")

CurDir = CreateObject ("WScript.Shell").CurrentDirectory & "\"


Set Thefolder = objFSO.GetFolder(CurDir)
StartTime = Now
WorkWithSubFolders Thefolder
EndTime = Now


Sub WorkWithSubFolders (AFolder)
Dim MoreFolders, TempFolder
FolderCount = FolderCount + 1

CheckExt AFolder
Set Morefolders = AFolder.Subfolders
For Each TempFolder In MoreFolders
WorkWithSubFolders (TempFolder)
Next

End Sub

Sub CheckExt (AFolder)
Dim Afile, TheFiles

On Error Resume Next
Set TheFiles = AFolder.Files
For Each Afile In TheFiles
If UCase(objFSO.GetExtensionName (AFile)) = "TXT" Then
Killfile (Afile)
ElseIf UCase(objFSO.GetExtensionName (AFile)) = "TMP" Then
Killfile (Afile)
End If
Next

End Sub

Sub Killfile (AFile)
On Error Resume Next
strModifyDay = day(Afile.DatelastModified)
If len(strModifyDay) < 2 Then
strModifyDay = "0" & strModifyDay
End If
strModifyMonth = Month(Afile.DateLastModified)
If len(strModifyMonth) < 2 Then
strModifyMonth = "0" & strModifyMonth
End If
strModifyYear = Year(Afile.DateLastModified)
strDate = strModifyYear & strModifyMonth & strModifyDay
If strDate < strTargetDate Then
objFSO.DeleteFile (AFile)
DeletedCount = DeletedCount + 1
End If
End Sub

 

[jges]

Just comment out the call to 'WorkWithSubFolders'.

Set Thefolder = objFSO.GetFolder(CurDir)
    StartTime = Now
    [COLOR=green]'WorkWithSubFolders Thefolder[/color]
    EndTime = Now

 

[PHV]

In fact you've to keep the main call.
Comment out this lines instead:
Set Morefolders = AFolder.Subfolders
For Each TempFolder In MoreFolders
WorkWithSubFolders (TempFolder)
Next

Another way is to replace this:
WorkWithSubFolders Thefolder
with this:
CheckExt Thefolder

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

 

[Icarus2010]

Hi, thanks. If I comment out that line, it dosent delete any files from the current folder, the folder the vbs script is being executed ?

 

[Icarus2010]

Yep, that worked PHV, thank you very much.

 

[jges]

Oops, sorry I pointed you to the wrong call.

A recursive function calls itself from within the function. To eliminate this behavior you would eliminate the call from within the function. I was a bit too quick to answer and pointed you to the wrong call.

Thanks PHV for correcting that!