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

完成イメージ（Before / After）

Before（実行前）

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

After（実行後 — 最小版）

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

After（実行後 — 実務版）

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

実行前の準備（必ず読むこと）

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

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

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

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

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

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のファイル削除はゴミ箱を経由しない完全削除です。バックアップを取ってから実行すること。

この実務版を使い始めてからは、共有フォルダの月次クリーンアップが定型作業になった。以前は「誰かがいつかやるだろう」と思って放置していたのが、今は月に1回ボタンを押すだけ。フォルダが常に整理された状態を保てるようになった。

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, False の False は「読み取り専用ファイルを削除しない」設定。読み取り専用ファイルも削除したい場合は True に変更する。ただし、意図しない削除を防ぐためデフォルトは False を推奨。

よくある落とし穴5選

VBAでファイル削除が失敗するときの対処法

「削除失敗：書き込みできません」とログに記録される場合、ファイルが読み取り専用属性になっているか、他のアプリで開かれている。読み取り専用ファイルも削除したい場合は fso.DeleteFile path, True とForce引数をTrueにする。開かれているファイルは閉じてから再実行する。

VBAで削除対象が多すぎるときの対処法

「想定より大量のファイルが削除対象になった」という場合、daysOld の日数設定が小さすぎることが原因だ。まず最小版（一覧表示のみ）で対象を確認し、日数を大きめ（180日や365日）から始めて徐々に絞っていくのが安全。

削除系マクロを実行する前の承認フロー

古いファイルの自動削除は便利ですが、VBAの中でも特に慎重に扱うべき処理です。一度削除したファイルは、環境によっては元に戻せないことがあります。そのため、実務ではいきなり削除せず、まず一覧化し、対象を確認し、必要なら承認を取ってから削除します。

自分のPCだけで使う場合でも、保存先が共有フォルダーやOneDriveの場合は、他の人が使っているファイルを消してしまう可能性があります。同じ部署で使うなら、対象フォルダー、削除基準日、除外する拡張子、バックアップ場所を決めてから運用するのが安全です。

• 最初は削除せず、対象ファイル一覧だけを出す
• 削除対象フォルダーを固定しすぎず、実行前に表示して確認する
• 共有フォルダーでは、担当者や管理者の確認を取る
• 重要ファイルの拡張子やフォルダーを除外する
• 削除ログを残し、いつ何を消したか後から追えるようにする

削除前に必ず確認メッセージを出す例

Dim answer As VbMsgBoxResult
answer = MsgBox("削除対象を確認しましたか？", vbYesNo + vbExclamation)

If answer <> vbYes Then
    MsgBox "削除を中止しました"
    Exit Sub
End If

この確認メッセージだけで完全に安全になるわけではありませんが、誤実行を止める最後の壁になります。削除系のマクロは、便利さよりも安全確認を優先してください。AdSense向けの記事としても、読者がそのまま実務で使って事故らないように、安全側の説明を厚くしておくことが大切です。

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

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

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

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

まとめ

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

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

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

関連記事：

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

次にやりたくなること

この記事の自動化ができたら、次はこんなことも試してみてください。

• 【VBA】フォルダ内のファイル一覧をExcelに自動出力する方法 — 削除前にフォルダの全体像を把握したいときに
• 【VBA】指定フォルダのファイルを自動バックアップする方法 — 削除する前にバックアップを自動化しておけば安心
• 【VBA】FileSystemObjectでサブフォルダを再帰検索してファイル一覧を取得する方法 — サブフォルダも含めて古いファイルを探したいときに