【VBA】古いファイルを自動削除する方法|一覧確認してから安全に削除(コピペOK)

VBA

この記事でできること

共有フォルダに古いファイルがたまり続けていませんか? VBAを使えば、指定日数より古いファイルを自動で見つけ出し、一覧で確認してから削除できます。この記事では「まず一覧表示→確認→削除」の安心3ステップで、初心者でも安全にフォルダを整理できるコードを紹介します。

  • 対象:共有フォルダの古いファイルを定期的に整理したい人、VBAが初めての人
  • 所要時間:コピペ → 実行まで約5分(最小版の場合。実務版の確認込みで約10分)

完成イメージ(Before / After)

Before(実行前)

フォルダに古いファイルと新しいファイルが混在している。どれを消していいか分からない。

After(実行後 — 最小版)

A B
1 報告書_202501.xlsx 2025/03/15 10:30
2 議事録_old.docx 2025/01/20 14:22
3 バックアップ_2024.zip 2024/11/05 09:15

A列に削除対象のファイル名、B列に更新日時が一覧表示される。この段階では削除しない。 ※ヘッダー行なし。1行目からファイル名が表示される。

After(実行後 — 実務版)

A B C
1 ファイル名 更新日時 結果
2 報告書_202501.xlsx 2025/03/15 10:30 削除済み
3 議事録_old.docx 2025/01/20 14:22 削除済み
4 バックアップ_2024.zip 2024/11/05 09:15 削除失敗:使用中

ドライランで一覧表示 → 確認ダイアログ → 削除実行。C列に結果ログが残る。


実行前の準備(必ず読むこと)

最重要:バックアップを取る

VBAでのファイル削除は、ゴミ箱を経由しない完全削除です。一度削除すると復元できません。

実行前に、対象フォルダをまるごとコピーしてバックアップを取ること。特に共有フォルダの場合は、他の利用者にも事前に連絡すること。

Excelをマクロ有効ブック(.xlsm)で保存する

  1. Excelを開く(新規でも既存でもOK)
  2. 「ファイル」→「名前を付けて保存」
  3. ファイルの種類を 「Excel マクロ有効ブック (*.xlsm)」 に変更して保存

.xlsx のままだとマクロが保存されない。必ず .xlsm にすること。


手順(コピペ → 実行まで約5分)

VBEを開く

Alt + F11 キーを押すとVBE(Visual Basic Editor)が開く。

一般的にはAlt + F11で開けるが、企業のセキュリティ設定でVBAが無効化されている場合は、IT部門に確認すること。

標準モジュールを挿入する

  1. VBEのメニュー「挿入」→「標準モジュール」をクリック
  2. 右側に白い画面(コードウィンドウ)が表示される

コードを貼り付けて実行する

  1. 下の「コード(最小版)」をコピーして、コードウィンドウに貼り付ける
  2. コード内の targetFolder を自分の対象フォルダのパスに書き換える
  3. daysOld を日数に書き換える(初期値は90日)
  4. Alt + F8 を押す(または VBE上で F5
  5. マクロ名を選択して「実行」
  6. Sheet1 に削除対象ファイルの一覧が表示されることを確認する

フォルダパスの確認方法: エクスプローラーでフォルダを開き、アドレスバーをクリックするとパスが表示される。それをコピーして使う。

パスの末尾に \ を忘れないこと。 例:C:\Users\tanaka\Documents\共有フォルダ\

日数の目安:

日数 意味
30 約1ヶ月前より古い
90 約3ヶ月前より古い(初期値)
180 約半年前より古い
365 約1年前より古い

迷ったら大きめの日数(180や365)から始めると安全。


コード(最小版)— 古いファイルを一覧表示するだけ(削除しない)

まずはこれで対象ファイルを確認する。このコードにファイル削除の処理は含まれていない。


Sub ListOldFiles()

    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim ws As Worksheet
    Dim row As Long
    Dim targetFolder As String
    Dim daysOld As Long

    ' ★ ここを自分のフォルダパスに書き換える(末尾の \ を忘れずに)
    targetFolder = "C:\Users\(ユーザー名)\Desktop\対象フォルダ\"

    ' ★ 何日以上前のファイルを対象にするか(例:90日)
    daysOld = 90

    ' FileSystemObject を作成(参照設定不要)
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' フォルダが存在するかチェック
    If Not fso.FolderExists(targetFolder) Then
        MsgBox "フォルダが見つかりません:" & targetFolder, vbExclamation
        Exit Sub
    End If

    Set folder = fso.GetFolder(targetFolder)
    Set ws = Worksheets("Sheet1")

    ' 出力先シートをクリア(※既存データがあると消えるので注意)
    ws.Cells.Clear

    row = 1

    ' フォルダ内の各ファイルをチェック
    For Each file In folder.Files
        ' 更新日時が指定日数より古いかを判定
        If file.DateLastModified < Now - daysOld Then
            ws.Cells(row, 1).Value = file.Name          ' A列:ファイル名
            ws.Cells(row, 2).Value = file.DateLastModified ' B列:更新日時
            row = row + 1
        End If
    Next file

    MsgBox row - 1 & " 件の古いファイルが見つかりました。" & vbCrLf & _
           "※ このマクロでは削除しません。一覧を確認してください。", vbInformation

    Set file = Nothing
    Set folder = Nothing
    Set fso = Nothing

End Sub

このコードは一覧表示だけを行う。ファイルは削除されない。 まずこれで「何が削除対象になるか」を確認すること。

シート名について: コード内の "Sheet1" はシート名(タブに表示される名前)。シート名を変更している場合は書き換えること。


コード(実務版)— ドライラン+確認+削除実行

最小版で対象ファイルを確認できたら、実務版に進む。ドライラン → 確認ダイアログ → 本実行の3ステップで動作する。

再度警告:VBAのファイル削除はゴミ箱を経由しない完全削除です。バックアップを取ってから実行すること。


Sub DeleteOldFiles()

    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim ws As Worksheet
    Dim row As Long
    Dim targetFolder As String
    Dim daysOld As Long
    Dim fileCount As Long
    Dim deletedCount As Long
    Dim failedCount As Long
    Dim targetFiles As Object
    Dim answer As VbMsgBoxResult
    Dim filePath As Variant
    Dim targetRow As Long

    ' ★ ここを自分のフォルダパスに書き換える(末尾の \ を忘れずに)
    targetFolder = "C:\Users\(ユーザー名)\Desktop\対象フォルダ\"

    ' ★ 何日以上前のファイルを対象にするか(例:90日)
    daysOld = 90

    ' FileSystemObject を作成(参照設定不要)
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' フォルダが存在するかチェック
    If Not fso.FolderExists(targetFolder) Then
        MsgBox "フォルダが見つかりません:" & targetFolder, vbExclamation
        Exit Sub
    End If

    Set folder = fso.GetFolder(targetFolder)
    Set ws = Worksheets("Sheet1")
    Set targetFiles = CreateObject("Scripting.Dictionary")

    ' 出力先シートをクリア
    ws.Cells.Clear

    ' ヘッダー行
    ws.Cells(1, 1).Value = "ファイル名"
    ws.Cells(1, 2).Value = "更新日時"
    ws.Cells(1, 3).Value = "結果"

    row = 2
    fileCount = 0

    ' --- ステップ1:ドライラン(一覧表示のみ) ---
    For Each file In folder.Files
        If file.DateLastModified < Now - daysOld Then
            ws.Cells(row, 1).Value = file.Name
            ws.Cells(row, 2).Value = file.DateLastModified
            ws.Cells(row, 3).Value = "(削除待ち)"
            targetFiles.Add file.Path, row
            row = row + 1
            fileCount = fileCount + 1
        End If
    Next file

    ' 対象ファイルが0件の場合
    If fileCount = 0 Then
        MsgBox "削除対象のファイルはありませんでした。", vbInformation
        GoTo Cleanup
    End If

    ' --- ステップ2:確認ダイアログ ---
    answer = MsgBox(fileCount & " 件のファイルが削除対象です。" & vbCrLf & vbCrLf & _
                    "【注意】この操作はゴミ箱を経由しない完全削除です。" & vbCrLf & _
                    "一度削除すると復元できません。" & vbCrLf & vbCrLf & _
                    "削除を実行しますか?", _
                    vbYesNo + vbExclamation, "削除の確認")

    If answer <> vbYes Then
        MsgBox "削除をキャンセルしました。" & vbCrLf & _
               "一覧はシートに残っています。", vbInformation
        GoTo Cleanup
    End If

    ' --- ステップ3:削除実行 ---
    deletedCount = 0
    failedCount = 0

    For Each filePath In targetFiles.Keys
        targetRow = targetFiles(filePath)

        On Error Resume Next
        fso.DeleteFile filePath, False  ' 読み取り専用は削除しない(True にすると読み取り専用も削除)
        If Err.Number = 0 Then
            ws.Cells(targetRow, 3).Value = "削除済み"
            deletedCount = deletedCount + 1
        Else
            ws.Cells(targetRow, 3).Value = "削除失敗:" & Err.Description
            failedCount = failedCount + 1
            Err.Clear
        End If
        On Error GoTo 0
    Next filePath

    MsgBox "完了しました。" & vbCrLf & _
           "削除: " & deletedCount & " 件" & vbCrLf & _
           "失敗: " & failedCount & " 件" & vbCrLf & _
           "詳細はシートのC列を確認してください。", vbInformation

Cleanup:
    Set targetFiles = Nothing
    Set file = Nothing
    Set folder = Nothing
    Set fso = Nothing

End Sub

コードの流れ:

  1. ドライラン — 対象ファイルをシートに一覧表示する(この時点では削除しない)
  2. 確認ダイアログ — 「○件のファイルを削除します。ゴミ箱を経由しない完全削除です」と警告。「いいえ」を押せばキャンセルできる
  3. 削除実行 — 「はい」を押した場合のみ削除。C列に結果(「削除済み」「削除失敗:理由」)を記録

Force引数について: fso.DeleteFile filePath, FalseFalse は「読み取り専用ファイルを削除しない」設定。読み取り専用ファイルも削除したい場合は True に変更する。ただし、意図しない削除を防ぐためデフォルトは False を推奨。


よくある落とし穴5選

# 症状 原因 対策
1 削除したファイルがゴミ箱にない(復元できない) VBAの fso.DeleteFile はゴミ箱を経由しない完全削除 実行前に必ず対象フォルダをバックアップする。最小版で一覧を確認してから実務版を実行する
2 「書き込みできません」「Permission denied」エラー 読み取り専用属性が付いたファイルを削除しようとした fso.DeleteFile path, True(Force引数をTrue)で削除可能。ただしデフォルトは False のまま推奨
3 特定のファイルだけ削除に失敗する ファイルが他のアプリケーション(Excel、Word等)で開かれている ファイルを閉じてから再実行する。C列のログで失敗したファイルを確認できる
4 想定より多くのファイルが削除対象になった daysOld の日数設定が小さすぎる まず最小版(一覧表示のみ)で対象を確認する。日数は大きめ(180日や365日)から始める
5 「フォルダが見つかりません」のメッセージが出る フォルダパスが間違っている、または末尾に \ がない エクスプローラーのアドレスバーからパスをコピーし、末尾に \ を付ける

FAQ

Q1: 削除したファイルをゴミ箱から復元できる?

できない。VBAの fso.DeleteFile はWindowsのゴミ箱を経由しない完全削除。実行前にフォルダごとバックアップを取ること。

Q2: 特定の拡張子(.tmp だけ、.log だけ)に絞って削除したい

コード内のIf文に条件を追加する。例えば .tmp ファイルだけを対象にする場合:


If file.DateLastModified < Now - daysOld Then
    If LCase(fso.GetExtensionName(file.Name)) = "tmp" Then
        ' この中に一覧表示/削除の処理を入れる
    End If
End If

Q3: 更新日時ではなく作成日時で判断したい

file.DateLastModifiedfile.DateCreated に書き換える。ただし、ファイルをコピーすると作成日時がリセットされる場合があるため、一般的には更新日時での判断を推奨。

Q4: サブフォルダ内のファイルも含めて削除したい

この記事のコードは指定フォルダの1階層のみ対象。サブフォルダも含める場合は再帰処理が必要になり、誤削除のリスクも高まる。業務に合わせたカスタマイズはココナラで相談できます。

Q5: 定期的に自動実行したい(毎週月曜に実行など)

Windowsのタスクスケジューラと組み合わせれば可能だが、確認ダイアログなしで削除が走るリスクがある。自動実行の設定は上級者向けのため、この記事では扱わない。


まとめ

この記事で、指定フォルダ内の古いファイル(更新日が指定日数以上前)を一覧表示し、確認してから安全に削除できるようになった。

  • 最小版:古いファイルを一覧表示するだけ。削除は行わない。まずはこれで確認
  • 実務版:ドライラン → 確認ダイアログ → 削除実行の3ステップ。C列にログも残る

くり返し注意:VBAのファイル削除はゴミ箱を経由しない完全削除です。必ずバックアップを取ってから実行してください。

関連記事:

  • ファイル一覧を先に確認したい場合は「【VBA】フォルダ内のファイル一覧をExcelに自動出力する方法」を参照
  • 削除ではなくコピー・移動で整理したい場合は「【VBA】ファイルを別フォルダにコピー・移動する方法」を参照

もっとカスタマイズしたい場合

「拡張子・サイズ・日付の組み合わせで条件付き削除したい」「サブフォルダも含めたい」「定期実行したい」など、業務に合わせたカスタマイズが必要な場合は、ココナラで相談できます。

相談時に以下の情報があるとスムーズです:

  • Excel のバージョン / OS
  • 対象フォルダのパス構成(階層の深さ)
  • 削除条件(日数、拡張子、サイズなど)
  • ファイルの数(目安)

あわせて読みたい

コメント

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