VBA100本ノック 21本目：バックアップファイルの削除
開いているブックの古いバックアップファイルを削除する問題です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。
出題
自身(ThisWorkbook)と同じフォルダに"BACKUP"フォルダがあります。
このフォルダ内に自身のバックアップが以下の名称で多数入っています。
ブック名_yyyymmddhhmm.xlsm
実行日を含め30日分だけ残し、古いファイルは削除してください。
※日付はファイル名で判断
頂いた回答
解説
まずはDir関数をDo…Loopで順次処理するVBAは覚えておいた方が良いでしょう。
フォルダに関係ないファイルを間違って入れてしまっている場合もあるので、ブック名のチェックはしたいですね。
Sub VBA100_21_01()
Dim wb As Workbook
Dim delLastDay As String
Set wb = ThisWorkbook
delLastDay = Format(Date - 30, "yyyymmdd")
Dim sPath As String
Dim sFile As String
Dim sExt As String
sPath = wb.Path & "\BACKUP"
If Dir(sPath, vbDirectory) = "" Then Exit Sub
sExt = Mid(wb.Name, InStrRev(wb.Name, ".") + 1)
sFile = Left(wb.Name, InStrRev(wb.Name, ".") - 1)
Dim tFile As String
tFile = Dir(sPath & "\" & sFile & "_*." & sExt)
Do Until tFile = ""
If tFile Like sFile & "_############." & sExt Then
If Mid(tFile, InStrRev(tFile, "_") + 1, 8) <= delLastDay
Then
On Error Resume Next
Kill sPath & "\" & tFile
End If
End If
tFile = Dir()
Loop
End Sub
Killは読み取り専用は削除できないのでエラー対応を入れました。
FSOは読み取り専用も削除できますが、それでも削除できない場合もあります。
（ファイルを開いている等）
DirをFSOに書き換えたコードは記事補足に掲載しました。
※掲載VBAは少々テスト不足かもしれません。
補足
基本は、
tFile = Dir(パス)
Do Until tFile = ""
・・・
tFile = Dir()
Loop
この構造だけしっかり把握していれば問題ないでしょう。
Do...LoopがFor Each...Nextになっているだけで、基本構造は同じですね。
Sub VBA100_21_02()
Dim wb As Workbook
Dim delLastDay As String
Set wb = ThisWorkbook
delLastDay = Format(Date - 30, "yyyymmdd")
Dim sPath As String
Dim sFile As String
Dim sExt As String
Dim fso As Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
sPath = wb.Path & "\BACKUP"
If Not fso.FolderExists(sPath) Then Exit Sub
sExt = fso.GetExtensionName(wb.Name)
sFile = fso.GetBaseName(wb.Name)
Dim tFile As File
For Each tFile In fso.GetFolder(sPath).files
If tFile.Name Like sFile & "_############." & sExt Then
If Mid(tFile.Name, InStrRev(tFile.Name, "_") + 1, 8) <=
delLastDay Then
On Error Resume Next
tFile.Delete Force:=True
End If
End If
Next
Set fso = Nothing
End Sub
文字列処理部分は、正規表現で処理する方法も考えられそうですが、
今回はかえってコードが長くなりそうなのでサンプルは書きませんでした。
サイト内関連ページ
同じテーマ「Python入門」の記事
VBA100本ノック 18本目：名前定義の削除
VBA100本ノック 19本目：図形のコピー
VBA100本ノック 20本目：ブックのバックアップ
VBA100本ノック 21本目：バックアップファイルの削除
VBA100本ノック 22本目：FizzBuzz発展問題
VBA100本ノック 23本目：シート構成の一致確認
VBA100本ノック 24本目：全角英数のみ半角
VBA100本ノック 25本目：マトリック表をDB形式に変換
VBA100本ノック 26本目：ファイル一覧作成
VBA100本ノック 27本目：ハイパーリンクのURL
VBA100本ノック 28本目：シートをブックに分割
新着記事NEW ・・・新着記事一覧を見る
VBA100本ノック 34本目：配列の左右回転｜VBA練習問題（11月28日）
VBA100本ノック 33本目：マクロ記録の改修｜VBA練習問題（11月26日）
VBA100本ノック 32本目：Excel終了とテキストファイル出力｜VBA練習問題（11月25日）
VBA100本ノック 31本目：入力規則｜VBA練習問題（11月24日）
将棋とプログラミングについて～そこには型がある～｜エクセル雑感（11月22日）
VBA100本ノック 30本目：名札作成（段組み）｜VBA練習問題（11月22日）
VBA100本ノック 29本目：画像の挿入｜VBA練習問題（11月21日）
VBA100本ノック 28本目：シートをブックに分割｜VBA練習問題（11月19日）
VBA100本ノック 27本目：ハイパーリンクのURL｜VBA練習問題（11月18日）
VBA100本ノック 26本目：ファイル一覧作成｜VBA練習問題（11月17日）
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.RangeとCellsの使い方｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.マクロって何？VBAって何？｜VBA入門
6.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門
7.繰り返し処理（For Next)｜VBA入門
8.セルに文字を入れるとは（Range,Value）｜VBA入門
9.とにかく書いてみよう（Sub,End Sub）｜VBA入門
10.マクロはどこに書くの（VBEの起動）｜VBA入門
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。