CODEWITHSUNDEEP
vbscript
Pathi
Pathi

Reputation: 1

I would like to delete 7 days older, files. folders and empty folders

I would like to delete 7 days older, files and empty folders. i have used below scripts from the link, but some files and folders are not getting deleted since the souce is pointing directly to drive letter. However, if we change the source folder c:\temp\lab everythings workes fine. 

Const Active = True
Const sSource = "E:"
Const MaxAge = 7 'days
Const Recursive = True

Checked = 0
Deleted = 0

Set oFSO = CreateObject("Scripting.FileSystemObject")
if active then verb = "Deleting """ Else verb = "Old file: """
CheckFolder oFSO.GetFolder(sSource)

WScript.echo
if Active then verb = " file(s) deleted" Else verb = " file(s) would be deleted"
WScript.Echo Checked & " file(s) checked, " & Deleted & verb

Sub CheckFolder (oFldr)
For Each oFile In oFldr.Files
Checked = Checked + 1
If DateDiff("D", oFile.DateLastModified, Now()) > MaxAge Then
Deleted = Deleted + 1
WScript.Echo verb & oFile.Path & """"
If Active Then oFile.Delete
End If
Next

if not Recursive then Exit Sub
For Each oSubfolder In oFldr.Subfolders
CheckFolder(oSubfolder)
Next
End Sub

Upvotes: 0

Views: 4269

Answers (1)

Panayot Karabakalov
Panayot Karabakalov

Reputation: 3179

Well, what about this:

Const Active     = True
Const sSource    = "E:\start_folder" 'or "E:\" but not "E:"
Const MaxAge     = 7 'days
Const Recursive  = True

Dim dtOld, Checked, Deleted, verb
dtOld   = Now - MaxAge
Checked = 0
Deleted = 0

If Active Then verb = "Deleting """ Else verb = "Old file: """

Validate sSource
Cleanup sSource

WScript.Echo
If Active Then verb = " file(s) deleted" Else verb = " file(s) would be deleted"
WScript.Echo Checked & " file(s) checked, " & Deleted & verb

Sub Validate(sFolder)
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(sFolder) Then
            Err.Raise 76 'Path not found
        End If
        If .GetFolder(sFolder).IsRootFolder Then
            If .GetDrive(.GetDriveName(sFolder)) = _
            CreateObject("WScript.Shell").Environment(_
            "PROCESS")("HOMEDRIVE") Then
                Err.Raise 75 'Path/File access error
            End If
        End If
    End With
End Sub

Sub Cleanup(sFolder)
    Dim obj
    With CreateObject("Scripting.FileSystemObject").GetFolder(sFolder)
        'recurse first
        If Recursive Then
            For Each obj In .SubFolders
                Cleanup obj
            Next
        End If
        'next delete oldest files
        For Each obj In .Files
            If obj.DateCreated < dtOld Then
                Deleted = Deleted + 1
                WScript.Echo verb & obj.Path & """"
                If Active Then obj.Delete(True)
            End If
        Next
        Checked = Checked + .Files.Count
        'and then delete old or empty folders
        For Each obj In .SubFolders
            If obj.DateCreated < dtOld Or 0 = obj.Size Then
                'count here in a variable if you like...
                If Active Then obj.Delete(True)
            End If
        Next
    End With
End Sub

P.S. Need to warn about one weak moment. FSO use a snapshot Folders collection, that mean during iteration FSO may try to access folder that no more exists. In other words, made separate procedure for deleting folders.

Upvotes: 1

Related Questions