この記事では、最終更新日からの経過日数に応じて指定フォルダ内のファイルを一括削除するVBAコードをご紹介していきます。
日数、週数、月数でそれぞれ指定する方法をご紹介していきます。
データ整理の際にぜひご活用ください。
なお、この記事で紹介するコードは前回の以下の記事を応用して書いていきます。
【VBA】ファイルの最終更新日からの経過日数を一括取得する方法！
前回とかぶっているところは省略していきますので、詳細なスキルから学びたいかたは、まずは前回の記事からご覧ください。
それでは本題に入っていきましょう。
処理対象ファイルの事前確認
この記事では、以下のフォルダ内のファイル達を最終更新日（作成日）からの経過日数に応じて削除していきます。
今回はフォルダ名と作成日時は一致しておりますが、これは記事の内容を理解しやすくするためだけのものです。
このようなファイル名でなくても問題なく機能しますのでご心配なく。
なお、この記事を書いているのは以下のとおり2021/06/08です。
以降の経過日数処理などはこの日時を基準に計算されます。
経過日数の一括取得するVBAコード
この項目はこれから削除されるファイルはどんなものなのかを確認するための作業です。
「そんなことはどうでもいいから経過日数の長いものを削除したい！」
という方は次の項目まで飛ばしてください。
というわけで、まずはこれから削除処理を行うファイル達の経過日数（週数、月数）を一覧化してみましょう。
以下が指定フォルダ内の（指定拡張子）ファイルのファイル名、最終更新日からの経過日数（週数、月数）を一括取得するVBAコードです。
※５行目、６行目はあなたの状況に応じて書き換えましょう。
Sub date_diff_file()
Dim base_path As String, extension As String
Dim file_name As String
Dim file_date As Date
Dim Diff_day As Integer, Diff_week As Integer, Diff_month As Integer
base_path = "C:\Users\Desktop\test"
extension = "JPG"
file_name = Dir(base_path & "\*" & extension, vbNormal)
i = 0
Do Until file_name = ""
file_date = FileDateTime(base_path & "\" & file_name)
Diff_day = DateDiff("d", file_date, Now())
Diff_week = DateDiff("w", file_date, Now())
Diff_month = DateDiff("m", file_date, Now())
Cells(2 + i, 1) = file_name
Cells(2 + i, 2) = Diff_day
Cells(2 + i, 3) = Diff_week
Cells(2 + i, 4) = Diff_month
file_name = Dir()
i = i + 1
Loop
End Subこいつを実行すると以下の結果が得られました。
※１行目は自分で記入する必要があります。
さきほども少し説明しましたが、A列のファイル名とそのファイルの最終更新日は一致しています。
さらにこのコードを実行したのは2021/06/08ですので、一番下のファイルは６日前ということになります。
しっかりB列の最終行には６が入っていますね。
というわけで問題なく各ファイルの経過日数、週数、月数を取得できました。
※上の画像で示されているとおり、以下は同じようで違うファイルを取得することになります。
〇経過日数が14日よりも長いファイル
〇経過日数が２週間よりも長いファイル
状況に応じて使い分けれるようになっておきましょう。
以降で紹介するVBAコードでは、これらの経過日数等に応じてファイルを削除していくことになります。
経過日数に応じてファイルを一括削除するVBAコード
それでは前置きが非常に長くなりましたが、ここからがこの記事の本題です。
次は先ほどのコードを修正して実際の削除作業に入っていきます。
さっそくですが、以下がそのVBAコードです。
〇最終更新日が１４日よりも前のファイルを削除する方法
※５行目、６行目はあなたの状況に応じて書き換えましょう。
Sub delete_file()
Dim base_path As String, extension As String
Dim file_name As String
Dim file_date As Date
Dim Diff_day As Integer, Diff_week As Integer, Diff_month As Integer
base_path = "C:\Users\Desktop\test"
extension = "JPG"
file_name = Dir(base_path & "\*" & extension, vbNormal)
Do Until file_name = ""
file_date = FileDateTime(base_path & "\" & file_name)
Diff_day = DateDiff("d", file_date, Now())
Diff_week = DateDiff("w", file_date, Now())
Diff_month = DateDiff("m", file_date, Now())
If Diff_day > 14 Then
Kill base_path & "\" & file_name
End If
file_name = Dir()
Loop
End Sub
早速実行してみましょう。
実行前のフォルダは以下の通りです。
先ほどのコードを実行すると以下のようになりました。
先ほどの一覧表と照らし合わせてみましょう。
１４日よりも前なので、20210523_1.JPGから上が対象になりますね。
上の処理後のフォルダはそれ以外が残されており、問題なく処理が行われていますね。
以上が日数指定で処理する方法でした。
次は週数に応じてやってみましょう。
とはいえ、ほぼコードは同じなので、修正点だけお伝えします。
〇週数指定にする方法（２週間よりも前の場合）
コード変更前：If Diff_day > 14 Then
コード変更後：If Diff_week > 2 Then
こいつをまた実行してみましょう。
※先ほど削除したファイルはバックアップをとっておりましたので、すべて元通りにしてから再実行していきます。
以下が実行結果です。
これも先ほどの一覧表と照らし合わせてみましょう。
今回はC列が３以上のものが削除されますので、2021/05/20_1.JPGよりも下のファイルだけ生き残ることになりますね。
上の画像を見ると問題なく処理できていそうですね。
最後に月数指定でやってみましょう。
もう変更点はわかりますよね。
〇月数指定にする方法（１か月以上前で指定）
コード変更前： If Diff_day > 14 Then
コード変更後： If Diff_month >=1 Then
こいつをまた実行してみましょう。
※先ほど削除したファイルはバックアップをとっておりましたので、すべて元通りにしてから再実行していきます。
以下が実行結果です。
先ほどの指定方法だと今月内に作成したもの以外が削除されます。
この記事を書いているのは６月ですので、６月に作成したファイル以外はすべて削除されていますね。
というわけで日数、週数、月数すべての場合で問題なく処理を実行できました。
おわりに
というわけで今回は指定フォルダ内にあるファイルの最終更新日からの経過日数を一括取得し、その日数に応じてファイルを削除する方法をご紹介しました。
ファイル整理の際などに是非ご活用ください。
また、記事内で紹介したスキルの詳細を勉強したい方は以下の記事をご覧ください。
【VBA】ファイルの最終更新日からの経過日数を一括取得する方法！
このように、私のブログではエクセルスキルはもちろん、様々なプログラミングスキルを紹介しています。
今は仕事中で時間がないかもしれませんが、ぜひ通勤時間中などに他の記事も読んでいただけると嬉しいです。
⇒興味をもった方は【ヒガサラ】で検索してみてください。
確実にスキルアップできるはずです。
最後に、この記事が役に立ったという方は、ぜひ応援よろしくお願いします。
↓ 応援ボタン
それではまた！
コメント
こんにちわ。
非常に参考になりました。
作成日時で削除したい場合も御教授頂けると助かります。
よろしくお願いします。
コメントありがとうございます(^^)
了解しました！
次の記事で書かせていただきますね。
少々お待ちください！
お待たせしました！
以下に詳細を載せておきましたのでご確認ください(^^)
【エクセルVBA】最終更新日が指定日と一致しているデータを一括削除する方法！