【VBA】最終更新日からの経過日数に応じてファイルを一括削除する方法!

この記事では、最終更新日からの経過日数に応じて指定フォルダ内のファイルを一括削除するVBAコードをご紹介していきます。

 

日数、週数、月数でそれぞれ指定する方法をご紹介していきます。

 

データ整理の際にぜひご活用ください。

 

なお、この記事で紹介するコードは前回の以下の記事を応用して書いていきます。

【VBA】ファイルの最終更新日からの経過日数を一括取得する方法!

前回とかぶっているところは省略していきますので、詳細なスキルから学びたいかたは、まずは前回の記事からご覧ください。

 

それでは本題に入っていきましょう。

 

スポンサーリンク

処理対象ファイルの事前確認

この記事では、以下のフォルダ内のファイル達を最終更新日(作成日)からの経過日数に応じて削除していきます。

今回はフォルダ名と作成日時は一致しておりますが、これは記事の内容を理解しやすくするためだけのものです。

このようなファイル名でなくても問題なく機能しますのでご心配なく。

 

なお、この記事を書いているのは以下のとおり2021/06/08です。

以降の経過日数処理などはこの日時を基準に計算されます。

 

スポンサーリンク

経過日数の一括取得するVBAコード

この項目はこれから削除されるファイルはどんなものなのかを確認するための作業です。

「そんなことはどうでもいいから経過日数の長いものを削除したい!」

という方は次の項目まで飛ばしてください。

 

というわけで、まずはこれから削除処理を行うファイル達の経過日数(週数、月数)を一覧化してみましょう。

以下が指定フォルダ内の(指定拡張子)ファイルのファイル名、最終更新日からの経過日数(週数、月数)を一括取得するVBAコードです。

※5行目、6行目はあなたの状況に応じて書き換えましょう。

Sub date_diff_file()
Dim base_path, extension, file_name As String
Dim file_date As Date
Dim Diff_day, Diff_week, 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

こいつを実行すると以下の結果が得られました。

※1行目は自分で記入する必要があります。

さきほども少し説明しましたが、A列のファイル名とそのファイルの最終更新日は一致しています。

さらにこのコードを実行したのは2021/06/08ですので、一番下のファイルは6日前ということになります。

しっかりB列の最終行には6が入っていますね。

というわけで問題なく各ファイルの経過日数、週数、月数を取得できました。

 

※上の画像で示されているとおり、以下は同じようで違うファイルを取得することになります。

〇経過日数が14日よりも長いファイル

〇経過日数が2週間よりも長いファイル

状況に応じて使い分けれるようになっておきましょう。

 

以降で紹介するVBAコードでは、これらの経過日数等に応じてファイルを削除していくことになります。

 

スポンサーリンク

経過日数に応じてファイルを一括削除するVBAコード

それでは前置きが非常に長くなりましたが、ここからがこの記事の本題です。

 

次は先ほどのコードを修正して実際の削除作業に入っていきます。

さっそくですが、以下がそのVBAコードです。

 

〇最終更新日が14日よりも前のファイルを削除する方法

※5行目、6行目はあなたの状況に応じて書き換えましょう。

Sub delete_file()
Dim base_path, extension, file_name As String
Dim file_date As Date
Dim Diff_day, Diff_week, Diff_month As Integer
base_path = "C:\Users\81907\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

 

早速実行してみましょう。

実行前のフォルダは以下の通りです。

先ほどのコードを実行すると以下のようになりました。

先ほどの一覧表と照らし合わせてみましょう。

14日よりも前なので、20210523_1.JPGから上が対象になりますね。

上の処理後のフォルダはそれ以外が残されており、問題なく処理が行われていますね。

 

以上が日数指定で処理する方法でした。

 

次は週数に応じてやってみましょう。

とはいえ、ほぼコードは同じなので、修正点だけお伝えします。

 

〇週数指定にする方法(2週間よりも前の場合)

コード変更前:If Diff_day > 14 Then

コード変更後:If Diff_week > 2 Then

 

こいつをまた実行してみましょう。

※先ほど削除したファイルはバックアップをとっておりましたので、すべて元通りにしてから再実行していきます。

 

以下が実行結果です。

これも先ほどの一覧表と照らし合わせてみましょう。

今回はC列が3以上のものが削除されますので、2021/05/20_1.JPGよりも下のファイルだけ生き残ることになりますね。

上の画像を見ると問題なく処理できていそうですね。

 

最後に月数指定でやってみましょう。

もう変更点はわかりますよね。

 

〇月数指定にする方法(1か月以上前で指定)

コード変更前: If Diff_day > 14 Then

コード変更後: If Diff_month >=1 Then

 

こいつをまた実行してみましょう。

※先ほど削除したファイルはバックアップをとっておりましたので、すべて元通りにしてから再実行していきます。

 

以下が実行結果です。

先ほどの指定方法だと今月内に作成したもの以外が削除されます。

この記事を書いているのは6月ですので、6月に作成したファイル以外はすべて削除されていますね。

 

というわけで日数、週数、月数すべての場合で問題なく処理を実行できました。

 

スポンサーリンク

おわりに

というわけで今回は指定フォルダ内にあるファイルの最終更新日からの経過日数を一括取得し、その日数に応じてファイルを削除する方法をご紹介しました。

ファイル整理の際などに是非ご活用ください。

 

また、記事内で紹介したスキルの詳細を勉強したい方は以下の記事をご覧ください。

【VBA】ファイルの最終更新日からの経過日数を一括取得する方法!

【VBA】複数フォルダ内の指定ファイルを一括削除する方法!

 

このように、私のブログではエクセルスキルはもちろん、様々なプログラミングスキルを紹介しています。

今は仕事中で時間がないかもしれませんが、ぜひ通勤時間中などに他の記事も読んでいただけると嬉しいです。

⇒興味をもった方は【ヒガサラ】で検索してみてください。

確実にスキルアップできるはずです。

 

最後に、この記事が役に立ったという方は、ぜひ応援よろしくお願いします。

↓ 応援ボタン

にほんブログ村 IT技術ブログ VBAへ
にほんブログ村

それではまた!

コメント

タイトルとURLをコピーしました