我想刪除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可能會嘗試訪問不存在的文件夾。換句話說，做了刪除文件夾的單獨過程。