0

我想删除 7 天前的文件和空文件夹。我从链接中使用了以下脚本，但是由于源直接指向驱动器号，因此某些文件和文件夹没有被删除。但是，如果我们更改源文件夹 c:\temp\lab 一切正常。 

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
4

1 回答 1

1

那么，这个呢：

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

PS需要警告一个弱时刻。FSO 使用快照Folders集合，这意味着在迭代期间 FSO 可能会尝试访问不再存在的文件夹。换句话说，为删除文件夹制作了单独的程序。

于 2013-03-21T00:44:08.003 回答