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 1 つの弱い瞬間について警告する必要があります。FSO はスナップショットFoldersコレクションを使用します。つまり、反復中に FSO が存在しないフォルダーにアクセスしようとする場合があります。つまり、フォルダを削除するための別の手順を作成しました。

于 2013-03-21T00:44:08.003 に答える