VBA100本ノック 21本目：バックアップファイルの削除

この記事から得るもの

FSO(FileSystemObject)と使って、1ヶ月経過したBackupファイルの削除方法が分かる。

１　今回のお題

自身(ThisWorkbook)と同じフォルダに"BACKUP"フォルダがあります。
このフォルダ内に自身のバックアップが以下の名称で多数入っています。
ブック名_yyyymmddhhmm.xlsm
実行日を含め30日分だけ残し、古いファイルは削除してください。
※日付はファイル名で判断

２　今回のお題の意図

差分Backupファイルの削除

３　回答

今回もパッと回答できたわけではなく、１つ１つ確認しながら作成しました。

どうやってファイル名から日付を取るか？

myStr = "20本目backup_202010130601.xlsm"
'拡張子を除いたファイル名
Get_str2 = Left(myStr, InStrRev(myStr, ".") - 1)

拡張子はドット（.）で区切られているので、InStrRev関数で何文字目か探してー１をした数値を、Left関数の抽出文字数とします。

次に、日付をを取ります。お題に、BOOK名は「ブック名_yyyymmddhhmm.xlsm」となっています。なので、Mid関数を使って、アンダーバー（_）以降の8文字を抽出します。

'_以降の日付を取得
Get_str3 = Mid(Get_str2, InStrRev(Get_str2, "_") + 1, 8)

Get_str3 に「20201013」が取得できました。しかし、このままでは文字列なので削除日付と比較することができません。
なので、Get_str3（20201013）を日付型に変換します。

'日付型に変換
Get_str4 = CDate(Format(Get_str3, "####/##/##"))

これでファイル名から日付を取得することができました。

ファイルの削除コマンド

ファイルの削除は「Kill フルPATH」で削除します。

'削除ファイルの設定
DelPath = ThisWorkbook.Path & "\BackUp"
myStr = "20本目backup_202010130601.xlsm"

'削除ファイル名から日付を取る
'拡張子を除いたファイル名
Get_str2 = Left(myStr, InStrRev(myStr, ".") - 1)            
'_以降の日付を取得    
Get_str3 = Mid(Get_str2, InStrRev(Get_str2, "_") + 1, 8)
'日付型に変換    
Get_str4 = CDate(Format(Get_str3, "####/##/##"))    

DelDate = Date - 30 '削除対象日付

'削除対象日以下の場合削除
If DelDate >= Get_str4 Then        
    Kill DelPath & "\" & myStr
End If

「Kill DelPath & "\" & myStr」のように、ファイルのフルPATHを指定して削除します。

ここまでだと、myStr = "20本目backup_202010130601.xlsm"のファイルしか処理ができません。
フォルダ内をループ処理するためにFSO（FileSystemObject）を使用します。

FSOでフォルダ内をループ処理する。

Sub FSO_フォルダ名取得()
'FSOを宣言
Dim fso_lord As Object: Set fso_lord = CreateObject("scripting.filesystemobject")

'削除フォルダ、削除日付を設定
DelPath = ThisWorkbook.Path & "\BackUp"     '削除対象フォルダ

'フォルダのファイルを読み込む
Set DelFile = fso_lord.getfolder(DelPath).Files

'ファイルの名前を取得する。
For Each file In DelFile
    Debug.Print file.Name
Next

End Sub

これでイミディエイトウィンドウに、フォルダ内のファイル名が表示されます。
このFSOのループ処理の中に、対象ファイルの日付の取得、削除対象ファイルの削除処理を混ぜ込みます。

最終回答

Sub ノック21本目_1()

'FSOを宣言
Dim fso_lord As Object: Set fso_lord = CreateObject("scripting.filesystemobject")

'削除フォルダ、削除日付を設定
DelPath = ThisWorkbook.Path & "\BackUp"     '削除対象フォルダ
DelDate = Date - 30                         '削除対象日付


'フォルダのファイルを読み込む
Set DelFile = fso_lord.getfolder(DelPath).Files


'削除処理
For Each file In DelFile
    '拡張子を除くファイル名を取得
    TargetFile = fso_lord.GetBaseName(file.Name)                    
    'ファイル名から日付を取得
    TargetDate = Mid(TargetFile, InStrRev(TargetFile, "_") + 1, 8)  
     '日付型に変換
    TargetDate = CDate(Format(TargetDate, "####/##/##"))           
    
    'ファイルの削除
    If DelDate >= TargetDate Then Kill DelPath & "\" & file.Name
    
Next

End Sub

４　感想

差分バックアップファイルの削除。データ量を減らすために大切です。今回のお題では、ファイル名から日付を取得していましたが、個人的にはファイルの更新日時（FSO.DateLastModified）から判断する方法がよいのではないかと思いました。
しかし、ファイル名からという問い合わせもあるかもしれないので、そこはファイル名のパターンを見極めて適切な処理を入れていかないとですね。

ではでは、このへんで(^^)/~~~