VBS 指定した日数より前のサブフォルダ名のサブフォルダを削除する部品

VBS 目次 - ray88’s diary

' 文字列を日付形式に変換する関数
Function ConvertToDate(strDate)
    On Error Resume Next ' エラーハンドリングの開始
    Dim year, month, day, hour, minute, second
    year = Mid(strDate, 1, 4)
    month = Mid(strDate, 5, 2)
    day = Mid(strDate, 7, 2)
    hour = Mid(strDate, 9, 2)
    minute = Mid(strDate, 11, 2)
    second = Mid(strDate, 13, 2)

    ConvertToDate = DateSerial(year, month, day) & " " & TimeSerial(hour, minute, second)

    If Err.Number <> 0 Then
        ConvertToDate = "Invalid Date"
        Err.Clear
    End If
    On Error GoTo 0 ' エラーハンドリングの終了
End Function

' 日付が指定された日数より前かどうかを判定する関数
Function IsOlderThan(dateString, days)
    Dim folderDate
    folderDate = ConvertToDate(dateString)
    
    If folderDate = "Invalid Date" Then
        IsOlderThan = "Invalid Date"
    Else
        IsOlderThan = DateDiff("d", folderDate, Now) > days
    End If
End Function

' サブフォルダを削除するサブルーチン
Sub DeleteSubFolder(folderPath)
    Dim FileSystemObject
    Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    
    If FileSystemObject.FolderExists(folderPath) Then
        FileSystemObject.DeleteFolder folderPath
    End If

    Set FileSystemObject = Nothing
End Sub

Dim ParentFolderPath, Days
ParentFolderPath = "ここに親フォルダパスを入力" ' 親フォルダのパスを設定
Days = 3 ' ここに日数を入力

Dim FileSystemObject, ParentFolder, SubFolder, olderThanResult
Dim foldersToDelete
Set foldersToDelete = CreateObject("Scripting.Dictionary")

Set FileSystemObject = CreateObject("Scripting.FileSystemObject")

If FileSystemObject.FolderExists(ParentFolderPath) Then
    Set ParentFolder = FileSystemObject.GetFolder(ParentFolderPath)
    For Each SubFolder in ParentFolder.SubFolders
        olderThanResult = IsOlderThan(SubFolder.Name, Days)
        If olderThanResult = True Then
            foldersToDelete.Add SubFolder.Path, SubFolder.Path
        ' ElseIf olderThanResult = "Invalid Date" Then
            ' 日付形式が無効の場合は削除しない
        ' Else
            ' 日数よりも前ではないため削除しない
        End If
    Next
    
    ' 削除対象のサブフォルダを削除
    Dim folderPathToDelete
    For Each folderPathToDelete in foldersToDelete.Keys()
        FileSystemObject.DeleteFolder folderPathToDelete
        ' MsgBox "Deleted: " & folderPathToDelete ' メッセージボックスの表示を削除
    Next
Else
    ' MsgBox "Specified parent folder does not exist: " & ParentFolderPath ' メッセージボックスの表示を削除
End If

Set FileSystemObject = Nothing