Detailed script to delete files and folders older than X days within a specific

latincork

Member
Hi All,
First of all please accept my apologies if I posted this thread in this section of the forum: I believe that the old section for "VBScript" thread is no longer active.

I state in advance that the following solution is not enough for me:"http://www.tek-tips.com/viewthread.cfm?qid=1687849" so I have decided to make a more detailed script that does this job and generates a specific log file in .csv format so that I can filter everything as per my reference.


[WAY THE SCRIPT WORKS]
This script is essentially based on two input parameters:

  • targetFolderPath (I believe it's meaningful)
  • threshold (all the files/folders older than this value will be deleted)
Additionally this script is designed in a such a way that if a folder is older than 'threshold' but contains files and/or sub-folders younger than 'threshold', it will not be deleted!


[MY PROBLEM]
The script works fine (I believe) but during my tests (before putting it in production) I discovered that strangely if I reduce the value of the "threshold" parameter to a value lower than 11 for example, then the result is a .csv log file that does NOT contain all the entries (actually 90% of them are missing!!! :().


[TROUBLESHOOTING STEPS ALREADY FOLLOWED]
I checked more in depth the script and I noticed that the problem is in the recursive call:"manage(childFolderPath)".


[THE SCRIPT]
Code:
'***************************************************
'
' Script Name:    gct.vbs (VBScript) 
' Title:              Garbage Collection Tool
' Author:           Latin Cork
' Created On:    August 2013
'
' Purpose:    Given the specific path of a folder, 
'                this  script  deletes  all the files 
'                and subfolders older than a specific
'                number of days
' Note:       Execute  the   script   with  delete
'                permissions on files and subfolders
'                This version  shows  each file  and 
'                folder deleted along with other
'               details
'
'***************************************************
 
On Error Resume Next


'*************************************************** Main Input


targetFolderPath = "C:\Users\latincork\Desktop\Scripts\GCT\Bin"    ' Folder to which this script will be applied to
threshold = 12   ' All the files/folders older than this value will be deleted
 
'*************************************************** Set objects & error catching


Dim fso
Dim objFolder
Dim objFile
Dim objSubFolder


Const readMode     = 1
Const writeMode = 2
Const appendMode = 8
Const informationFlag = 64
Const errorFlag = 48
Const bytesToKB = 1024


outputResult = "Type,Full Path,Size (KB),Last Modified,Age (Days),Action" & vbCrLf
targetFile = "Log_Result_" & date() & ".csv"
targetFile = replace(targetFile, "/", "-")
title = "Garbage Collection Tool"
timeOut = 30 'Number of seconds after which the initial popup window disappears
initialMessage = "Target Folder: " & targetFolderPath & vbCrLf & vbCrLf & "Deleting files older than " & threshold & " days..."
finalMessage = "Task Completed!"


'*************************************************** Main sub-routine


Sub manage(currentFolderPath)
    Dim childFolderPath
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set parentFolderPath = fso.GetFolder(currentFolderPath)
    
    'Delete each file
    For Each objFile In parentFolderPath.files
        ageOfCurrentFile = DateDiff("d", objFile.DateLastModified,Now)
        sizeOfCurrentFile = round(objFile.Size / bytesToKB)        
        If ageOfCurrentFile > threshold Then                        
            outputResult = outputResult & "File," & objFile.Path & "," & sizeOfCurrentFile & "," & objFile.DateLastModified & "," & ageOfCurrentFile & ",Deleted" & vbCrLf                        
            objFile.Delete True
        Else
            outputResult = outputResult & "File," & objFile.Path & "," & sizeOfCurrentFile & "," & objFile.DateLastModified & "," & ageOfCurrentFile & ",Skipped" & vbCrLf
        End If
    Next
    
    'Delete each sub-folder
    For Each objSubFolder In parentFolderPath.Subfolders
        childFolderLastModDate = objSubFolder.DateLastModified        
        childFolderPath = objSubFolder.Path
        ageOfCurrentFolder = DateDiff("d", childFolderLastModDate,Now)
        If isEmpty(childFolderPath) Then
            If ageOfCurrentFolder > threshold Then
                deleteCurrentFolder childFolderPath, childFolderLastModDate 
            Else
                outputResult = outputResult & "Folder," & childFolderPath & ",0," & childFolderLastModDate & "," & ageOfCurrentFolder & ",Skipped" & vbCrLf
            End If
        Else
            manage(childFolderPath)
            If isEmpty(childFolderPath) Then
                If ageOfCurrentFolder > threshold Then
                    deleteCurrentFolder childFolderPath, childFolderLastModDate 
                Else
                    outputResult = outputResult & "Folder," & childFolderPath & ",0," & childFolderLastModDate & "," & ageOfCurrentFolder & ",Skipped" & vbCrLf
                End If
            Else
                outputResult = outputResult & "Folder," & childFolderPath & ",0," & childFolderLastModDate & "," & ageOfCurrentFolder & ",Skipped" & vbCrLf
            End If
        End If
    Next    
End Sub


'*************************************************** Delete a specific folder and logs this action 


Sub deleteCurrentFolder(myFolderPath, lastModificationDate)
    Set folderToDelete = CreateObject("Scripting.FileSystemObject")
    ageOfFolder = DateDiff("d", lastModificationDate,Now)
    outputResult = outputResult & "Folder," & myFolderPath & ",0," & lastModificationDate & "," & ageOfFolder & ",Deleted" & vbCrLf
    folderToDelete.DeleteFolder(myFolderPath)
End Sub


'*************************************************** Create log file 


Sub createLogFile(filePath)
    set objFSO    = CreateObject("Scripting.FileSystemObject")
    set myFile = objFSO.OpenTextFile(targetFile, writeMode, True, -2)
    myFile.WriteLine outputResult
    myFile.close
End Sub
 
'*************************************************** Check if current folder is empty


Function isEmpty(myFolder)
    Dim objFSO, objFolder
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If objFSO.FolderExists(myFolder) Then
        Set objFolder = objFSO.GetFolder(myFolder)    
        If objFolder.Files.Count = 0 And objFolder.SubFolders.Count = 0 Then
            isEmpty = True
        Else
            isEmpty = False
        End If
    End If 
End Function


'*************************************************** Show popup message for a limited amount of time only


Sub showMessage(when)
    Select Case when
        Case "begin"
            Set objShell = CreateObject("Wscript.Shell")
            intReturn = objShell.Popup(initialMessage, timeOut, title, informationFlag)
        Case "end"
            MsgBox finalMessage, informationFlag, title        
    End Select    
End Sub


'*************************************************** Start Script


showMessage("begin")
manage(targetFolderPath)
createLogFile(targetFile)
showMessage("end")

Note: I have also uploaded a .zip file called "exampleOfLogFiles.zip" containing the 2 different types of log files I get if I set the value of the "threshold" parameter respectively to 11 and 15.

I would be very very grateful if somebody is able to help me or to point me to the right direction.

Thanks in advance.

Kind Regards,
Latin Cork :)
 

Attachments

  • exampleOfLogFiles.zip
    5.8 KB · Views: 0

My Computer

Hi,

I have run the script on several folders & varying age file/ folders, down to 1 day. All of the reports I got were correct at my end!
 

My Computer

System One

  • Manufacturer/Model
    HP-Pavilion m9280.uk-a
    CPU
    2.30 gigahertz AMD Phenom 9600 Quad-Core
    Motherboard
    ASUSTek Computer INC. NARRA3 3.02
    Memory
    3582 Megabytes Usable Installed Memory (4 Gig)
    Graphics Card(s)
    ASUS NVIDIA Geforce GTS450
    Sound Card
    Realtek High Definition 7.1 Audio (HP drivers)
    Monitor(s) Displays
    HP w2408 24.0" (Dual monitor)
    Screen Resolution
    1920 * 1200, 1920 * 1200
    Hard Drives
    3*500 Gigabytes Usable Hard Drive Capacity
    Plus 2x USB (160Gig each) external HDD
    BluRay & DVD Weiters
    HL-DT-ST BD-RE GGW-H20L SCSI CdRom (Bluray RW) Device
    AlViDrv BDDVDROM SCSI CdRom (Blueray) Device
    TSSTcorp CDDVDW TS-H653N SCSI CdRom
    Internet Speed
    40 Meg
@Lottiemansion

Then the problem must be between my chair and my desk
:geek:

It's very very strange but you know what? I'm going to use a couple of arrays where to take note of the full paths of all the files and folders to delete/skip.

Please let me know if you are interested in the final version of this script using arrays :)

Hugs,
Latin Cork
 

My Computer

Back
Top