フォルダ内のすべてのファイルが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

あなたが唯一の指定された制限よりも古いファイルを削除した場合、マッチ内のすべてのファイルを以前の状態ならば、フォルダにのみ、最初に一致したファイルを削除し、その後、彼らは空になっている場合のみ、フォルダを削除、削除する必要があります。

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 

あなたは、あなたが最初にeveryting

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 

Answer 2

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