Do not delete a folder until all files in the folder are more than 24 hours old

advertisements

I'm having a problem with my vsb file. I'm trying to create a script that deletes all files and folders that are older than 24 hours, but it should NOT delete a directory until all the files in it are older than 24 hours. The problem with my script is that it removes all directories even if there are files in it that are younger than 24 hours. I can't really find a solution to my problem, I have searched on google and nothing helped. This is my script :

    Const strPath = "D:\shared\temp"
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Call Search (strPath)
Sub Search(str)
 Dim objFolder, objSubFolder, objFile
 Set objFolder = objFSO.GetFolder(str)
 For Each objFile In objFolder.Files
  If objFile.DateCreated < (Now() - 1) Then
   objFile.Delete(True)
  End If
 Next
 For Each objSubFolder In objFolder.Subfolders
  Flag = ""
  If objSubFolder.DateCreated < (Now() - 1) Then
   For Each Thing in objSubFolder
    If thing.DateCreated > Now() - 1 then Flag="yes"
   Next
   If Flag = "yes" then objSubFolder.Delete(True)
  End If
 Next
End Sub

If anyone here knows what I can change in my script to make it work i would really appreciate the help.


If you only delete files older than a indicated limit, and folders should only be deleted if all the files inside match the previous condition, first remove the matching files and then remove folders only if they are empty.

Option Explicit

Dim strPath
    strPath = "d:\shared\temp"

    Call removeOldFiles( strPath, DateAdd("h", -24, Now()), False )

Sub removeOldFiles( ByVal currentFolder, timeLimit, deleteFolder )
    ' Retrieve a reference to currentFolder if it is not a FSO.Folder
    If TypeName( currentFolder ) <> "Folder" Then
        With WScript.CreateObject("Scripting.FileSystemObject")
            If .FolderExists( currentFolder ) Then
                Set currentFolder = .GetFolder( currentFolder )
            Else
                Exit Sub
            End If
        End With
    End If

    ' Remove files older than timeLimit
    Dim oFile
    For Each oFile In currentFolder.Files
        If oFile.DateCreated < timeLimit Then
            Call oFile.Delete( True )
        End If
    Next 

    ' Recursive call to clean each subfolder
    Dim oSubFolder
    For Each oSubFolder In currentFolder.Subfolders
        Call removeOldFiles( oSubFolder, timeLimit, True )
    Next 

    ' If the folder is old enough and it is empty, remove it
    If  currentFolder.DateCreated < timeLimit _
        And currentFolder.Files.Count = 0 _
        And currentFolder.SubFolders.Count = 0 _
        And deleteFolder _
    Then
        Call currentFolder.Delete( True )
    End If
End Sub

If you need to keep all files/folders until everything is older and then remove all, then you will need to first check everyting

Option Explicit

Dim strPath
    strPath = "d:\shared\temp"

    Call removeOldFolder( strPath, DateAdd("h", -24, Now()) )

Sub removeOldFolder( ByVal currentFolder, timeLimit )
    If recurseCheckOldData( currentFolder, timeLimit ) Then
        Call currentFolder.Delete( True )
    End If
End Sub

Private Function recurseCheckOldData( ByRef currentFolder, timeLimit )
    ' Until everything is checked, the data is considered newer than timeLimit
    recurseCheckOldData = False

    ' Retrieve a reference to currentFolder if it is not a FSO.Folder
    If TypeName( currentFolder ) <> "Folder" Then
        With WScript.CreateObject("Scripting.FileSystemObject")
            If .FolderExists( currentFolder ) Then
                Set currentFolder = .GetFolder( currentFolder )
            Else
                Exit Function
            End If
        End With
    End If

    ' Check current folder time
    If  currentFolder.DateCreated > timeLimit Then
        Exit Function
    End If 

    ' Check current folder files
    Dim oFile
    For Each oFile In currentFolder.Files
        If oFile.DateCreated > timeLimit Then
            Exit Function
        End If
    Next 

    ' Recursive call to check each subfolder
    Dim oSubFolder
    For Each oSubFolder In currentFolder.Subfolders
        If Not recurseCheckOldData( oSubFolder, timeLimit ) Then
            Exit Function
        End If
    Next 

    ' Up to now everything is older than the indicated time
    recurseCheckOldData = True
End Function