簡単エクセルマクロ日記

説明は苦手なのであしからず

ファイル削除を改良

1週間分だけ保持するように変更。


Private Sub trushClear(backupPath As String, objFSO As Object)
    
    'バックアップフォルダの存在チェック
    If Dir(backupPath, vbDirectory) = "" Then
        MkDir backupPath
    End If
    
    '指定したフォルダパスとファイル名をセットする
    Dim setPath As String
    setPath = Dir(backupPath & "\残したいファイル_*.xlsm")
    
    'バックアップ日付
    Dim bkDate As String
    
    'ファイル名が取得出来なくなるまでループ
    Do While setPath <> ""
        'ファイル名によって開始位置は変わる
        bkDate = Mid(setPath, 9, 8)
        
        '※ファイル名にバックアップした日付をつける
        If bkDate < Format(Date - 7, "yyyymmdd") Then

            Kill backupPath & "\" & Format(Date, "yyyymmdd") & "残したいファイル_*.xlsm"
’            MsgBox "ファイル:" & setPath & "  日付:" & bkDate

        End If
    
        setPath = Dir()
        
    Loop
    
End Sub