我想删除7天以前的文件。文件夹和空文件夹

Question

我想删除7天以前的文件和空文件夹。我从链接中使用了下面的脚本，但由于souce直接指向驱动器号，因此某些文件和文件夹不会被删除。但是，如果我们更改源文件夹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 

Answer 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 

附：需要警告关于一个弱点。 FSO使用快照Folders集合，这意味着在迭代过程中FSO可能会尝试访问不存在的文件夹。换句话说，做了删除文件夹的单独过程。