在文件夹中的所有文件都超过24小时之前，请勿删除文件夹

Question

我的vsb文件有问题。 我正在尝试创建一个脚本，该脚本删除所有早于24小时的文件和文件夹，但是它不应删除目录，直到其中的所有文件都早于24小时。 我的脚本的问题在于，即使其中包含的文件少于24小时，它也会删除所有目录。 我真的找不到解决问题的方法，我已经在Google上搜索了，没有任何帮助。 这是我的脚本：

    Const strPath = "D:\shared\temp"
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Call Search (strPath)
Sub Search(str)
 Dim objFolder, objSubFolder, objFile
 Set objFolder = objFSO.GetFolder(str)
 For Each objFile In objFolder.Files
  If objFile.DateCreated < (Now() - 1) Then
   objFile.Delete(True)
  End If
 Next
 For Each objSubFolder In objFolder.Subfolders 
  Flag = ""
  If objSubFolder.DateCreated < (Now() - 1) Then
   For Each Thing in objSubFolder
    If thing.DateCreated > Now() - 1 then Flag="yes"
   Next
   If Flag = "yes" then objSubFolder.Delete(True)
  End If
 Next
End Sub

如果这里有人知道我可以在脚本中进行哪些更改以使其正常运行，我将非常感谢您的帮助。

Answer 1

For Each objSubFolder In objFolder.Subfolders
    Flag = ""   
    If objSubFolder.DateCreated < (Now() - 1) Then
        For Each Thing in objSubFolder
            If thing.DateCreated > Now() - 1 then Flag="yes"
        Next
        If Flag = "yes" then objSubFolder.Delete(True)
    End If
Next

Answer 2

如果仅删除早于指定限制的文件，并且仅当内部所有文件均符合先前条件时才删除文件夹，请首先删除匹配的文件，然后仅在文件为空时删除文件夹。

Option Explicit

Dim strPath
    strPath = "d:\shared\temp"

    Call removeOldFiles( strPath, DateAdd("h", -24, Now()), False )

Sub removeOldFiles( ByVal currentFolder, timeLimit, deleteFolder )
    ' Retrieve a reference to currentFolder if it is not a FSO.Folder
    If TypeName( currentFolder ) <> "Folder" Then 
        With WScript.CreateObject("Scripting.FileSystemObject")
            If .FolderExists( currentFolder ) Then 
                Set currentFolder = .GetFolder( currentFolder )
            Else 
                Exit Sub
            End If 
        End With
    End If

    ' Remove files older than timeLimit
    Dim oFile    
    For Each oFile In currentFolder.Files 
        If oFile.DateCreated < timeLimit Then 
            Call oFile.Delete( True )
        End If
    Next 

    ' Recursive call to clean each subfolder
    Dim oSubFolder    
    For Each oSubFolder In currentFolder.Subfolders
        Call removeOldFiles( oSubFolder, timeLimit, True )
    Next 

    ' If the folder is old enough and it is empty, remove it
    If  currentFolder.DateCreated < timeLimit _ 
        And currentFolder.Files.Count = 0 _ 
        And currentFolder.SubFolders.Count = 0 _ 
        And deleteFolder _ 
    Then 
        Call currentFolder.Delete( True )
    End If
End Sub 

如果需要保留所有文件/文件夹，直到所有文件/文件夹都变旧，然后再删除所有文件/文件夹，则需要首先检查所有文件/文件夹

Option Explicit

Dim strPath
    strPath = "d:\shared\temp"

    Call removeOldFolder( strPath, DateAdd("h", -24, Now()) )

Sub removeOldFolder( ByVal currentFolder, timeLimit )
    If recurseCheckOldData( currentFolder, timeLimit ) Then 
        Call currentFolder.Delete( True )
    End If 
End Sub

Private Function recurseCheckOldData( ByRef currentFolder, timeLimit )
    ' Until everything is checked, the data is considered newer than timeLimit
    recurseCheckOldData = False

    ' Retrieve a reference to currentFolder if it is not a FSO.Folder
    If TypeName( currentFolder ) <> "Folder" Then 
        With WScript.CreateObject("Scripting.FileSystemObject")
            If .FolderExists( currentFolder ) Then 
                Set currentFolder = .GetFolder( currentFolder )
            Else 
                Exit Function
            End If 
        End With
    End If

    ' Check current folder time
    If  currentFolder.DateCreated > timeLimit Then 
        Exit Function
    End If 

    ' Check current folder files
    Dim oFile    
    For Each oFile In currentFolder.Files 
        If oFile.DateCreated > timeLimit Then 
            Exit Function
        End If
    Next 

    ' Recursive call to check each subfolder
    Dim oSubFolder
    For Each oSubFolder In currentFolder.Subfolders
        If Not recurseCheckOldData( oSubFolder, timeLimit ) Then 
            Exit Function
        End If 
    Next 

    ' Up to now everything is older than the indicated time
    recurseCheckOldData = True
End Function