【VBA】フォルダ内のファイルを日付フォルダに自動バックアップする方法（コピペOK）

Q: Excelファイルだけをバックアップしたい

Dir の引数を変更する： `` vba fileName = Dir(srcFolder & "*.xlsx") '← Excelファイルだけ ` 実務版（FSO）の場合は、ループ内で拡張子をチェックする： ` vba For Each f In fso.GetFolder(srcFolder).Files If LCase(fso.GetExtensionName(f.Name)) = "xlsx" Then fso.CopyFile f.Path, backupFolder & f.Name, True count = count + 1 End If Next f ``

Q: 大量のファイルがあると時間がかかる

100件程度なら数秒で完了する。1000件を超える場合は、 Application.StatusBar で進捗を表示するとよい： `` vba Application.StatusBar = count & " / " & totalFiles & " 件コピー中..." ' ループ終了後にリセット Application.StatusBar = False ``

Q: ボタン1つでバックアップを実行したい

「【VBA】マクロをボタン1つで実行する方法」で BackupFilesAdvanced をボタンに割り当てる。

VBA

2026.03.242026.04.27

この記事でできること
完成イメージ（Before / After）
どんな場面で使う？
実行前の準備
手順（コピペ → 実行まで約5分）
コード（最小版）– 指定フォルダを日付フォルダにバックアップ
1. 書き換えポイント
2. コードの流れ
コード（実務版）– 古いバックアップを自動削除（世代管理）
1. 書き換えポイント
2. コードの流れ
よくある落とし穴5選
FAQ
まとめ
1. 関連記事
次にやりたくなること

この記事でできること

VBAで指定フォルダ内のファイルを日付フォルダに自動バックアップできる
日付フォルダが自動作成されるため、手動でフォルダを作る必要がない
古いバックアップを自動削除する世代管理もできる（実務版）

対象: Excel 2016以降 / Microsoft 365、Windows 10/11

大事なファイルを上書きしてしまって冷や汗をかいた経験がある。手動バックアップは忘れる。VBAで自動化してからは、毎日の保存時に日付フォルダへコピーされる安心感がある。

—

完成イメージ（Before / After）

Before（手動バックアップ）:

バックアップ用のフォルダを手動で作成
対象ファイルを選択してコピー＆ペースト
フォルダ名に日付を手入力
週に1回のつもりが忘れて、気づいたら2週間分溜まっている
上書き保存で過去データを失うリスクに怯える

After（VBAで自動バックアップ）:

マクロを実行（またはボタンをクリック）
「backup_20260307」のような日付フォルダが自動作成される
指定フォルダ内の全ファイルが日付フォルダにコピーされる
完了メッセージで件数を確認

—

自分も以前、月末の集計ファイルを上書き保存してしまい、前月のデータが消えた。バックアップしていなくて、1日かけて手作業で復元した。あの焦りは二度と味わいたくない。VBAで日付フォルダにバックアップする仕組みを作ってからは、上書き事故が起きても前日分がすぐ見つかる。安心感が全然違う。同じヒヤリ体験をしたことがある人に、この記事で「もう上書きが怖くない」状態を作ってほしい。

バックアップは「やらなきゃ」と思いつつ忘れる作業の代表。VBAに任せれば忘れようがない。

—

どんな場面で使う？

月末の集計ファイルを毎日バックアップして上書き事故に備えたい
共有フォルダのデータを日付フォルダに自動コピーしておきたい
古いバックアップを自動削除して、ストレージを圧迫しないようにしたい
ファイルを手動でコピーする作業を忘れがちで、自動化したい

—

なお、ファイルのコピー・移動の基本は「【VBA】ファイルを別フォルダにコピー・移動する方法」を参照。この記事では「日付フォルダの自動作成 + 一括コピー」に特化する。

—

実行前の準備

バックアップ元のフォルダパスを確認する

コード内で指定するフォルダのパスを確認しておく。エクスプローラーでフォルダを開き、アドレスバーからパスをコピーするのが確実。

例: C:\Users\tanaka\Documents\品質データ

バックアップ先の親フォルダを決める

日付フォルダが作られる場所を決めておく。バックアップ元と同じドライブ内が無難。

例: C:\Users\tanaka\Documents\品質データ_backup

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

拡張子が .xlsx のままだとマクロが保存できない。

「ファイル」→「名前を付けて保存」
ファイルの種類を「Excelマクロ有効ブック (*.xlsm)」に変更
保存

—

手順（コピペ → 実行まで約5分）

VBE（コードを書く画面）を開く

Excelで Alt + F11 を押す
VBE（Visual Basic Editor）が開く

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

VBEのメニュー →「挿入」→「標準モジュール」
白い画面（コードウィンドウ）が表示される

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

コードウィンドウに、下のコードをそのままコピペする
Alt + F8 → マクロ名を選んで「実行」

ボタンに割り当てれば毎回Alt+F8を押さなくて済む。方法は「【VBA】マクロをボタン1つで実行する方法」を参照。

—

コード（最小版）– 指定フォルダを日付フォルダにバックアップ


'============================================================
' ■ 指定フォルダのファイルを日付フォルダにバックアップ（最小版）
'   → バックアップ元の全ファイルを日付フォルダにコピー
'============================================================
Sub BackupFilesMinimal()

    '--- ★書き換えポイント ---
    Dim srcFolder As String
    srcFolder = "C:\Users\tanaka\Documents\品質データ"   '← バックアップ元フォルダ

    Dim destParent As String
    destParent = "C:\Users\tanaka\Documents\品質データ_backup"  '← バックアップ先の親フォルダ
    '--- ★ここまで ---

    '--- パスの末尾に \ を付ける
    If Right(srcFolder, 1) <> "\" Then srcFolder = srcFolder & "\"
    If Right(destParent, 1) <> "\" Then destParent = destParent & "\"

    '--- 日付フォルダ名を作成（例: backup_20260307）
    Dim backupFolder As String
    backupFolder = destParent & "backup_" & Format(Date, "yyyyMMdd") & "\"

    '--- バックアップ先の親フォルダが存在するか確認
    If Dir(destParent, vbDirectory) = "" Then
        MsgBox "バックアップ先の親フォルダが見つかりません。" & vbCrLf & _
               destParent, vbExclamation
        Exit Sub
    End If

    '--- 日付フォルダがなければ作成
    If Dir(backupFolder, vbDirectory) = "" Then
        MkDir backupFolder
    End If

    '--- ファイルを1つずつコピー
    Dim fileName As String
    Dim count As Long
    count = 0

    fileName = Dir(srcFolder & "*.*")   '← 全ファイルを対象
    Do While fileName <> ""
        FileCopy srcFolder & fileName, backupFolder & fileName
        count = count + 1
        fileName = Dir()   '← 次のファイル
    Loop

    '--- 完了メッセージ
    If count > 0 Then
        MsgBox count & " 件のファイルをバックアップしました。" & vbCrLf & _
               "保存先: " & backupFolder, vbInformation
    Else
        MsgBox "バックアップ対象のファイルが見つかりませんでした。", vbExclamation
    End If

End Sub

書き換えポイント

変数	説明	初期値
`srcFolder`	バックアップ元のフォルダパス	`"C:\Users\tanaka\Documents\品質データ"`
`destParent`	バックアップ先の親フォルダパス	`"C:\Users\tanaka\Documents\品質データ_backup"`

コードの流れ

バックアップ元と保存先の親フォルダを指定
Format(Date, "yyyyMMdd") で今日の日付文字列を生成
MkDir で日付フォルダを自動作成（既にあればスキップ）
Dir でバックアップ元の全ファイルを列挙
FileCopy で1ファイルずつ日付フォルダにコピー
コピー件数を表示

重要: Dir はファイル名だけを返す。フルパスは srcFolder & fileName のように自分で組み立てる。Dir関数によるファイル列挙の詳しい使い方は「【VBA】フォルダ内のファイル一覧を自動取得する方法」を参照。

—

コード（実務版）– 古いバックアップを自動削除（世代管理）

実務ではバックアップが溜まり続けてディスクを圧迫する。「N日より前のバックアップは自動削除する」世代管理を追加した版。

世代管理を入れてからは、バックアップフォルダが際限なく膨らむ心配がなくなった。ディスク容量の警告が来なくなって、地味にストレスが減った。「バックアップは取っているけど、古いのが溜まっていく」という不安が消えたのが大きい。


'============================================================
' ■ 日付フォルダにバックアップ＋古いバックアップを自動削除（実務版）
'   → バックアップ後、指定日数を超えた古い日付フォルダを削除
'   → FSO（FileSystemObject）を使用（参照設定不要）
'============================================================
Sub BackupFilesAdvanced()

    '--- ★書き換えポイント ---
    Dim srcFolder As String
    srcFolder = "C:\Users\tanaka\Documents\品質データ"   '← バックアップ元フォルダ

    Dim destParent As String
    destParent = "C:\Users\tanaka\Documents\品質データ_backup"  '← バックアップ先の親フォルダ

    Dim keepDays As Long
    keepDays = 30                '← バックアップを保持する日数（これより古いものを削除）
    '--- ★ここまで ---

    '--- パスの末尾に \ を付ける
    If Right(srcFolder, 1) <> "\" Then srcFolder = srcFolder & "\"
    If Right(destParent, 1) <> "\" Then destParent = destParent & "\"

    '--- FSO（FileSystemObject）を生成
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    '--- バックアップ元フォルダの存在確認
    If Not fso.FolderExists(srcFolder) Then
        MsgBox "バックアップ元フォルダが見つかりません。" & vbCrLf & _
               srcFolder, vbExclamation
        Exit Sub
    End If

    '--- バックアップ先の親フォルダがなければ作成
    If Not fso.FolderExists(destParent) Then
        fso.CreateFolder destParent
    End If

    '--- 日付フォルダ名を作成
    Dim backupFolder As String
    backupFolder = destParent & "backup_" & Format(Date, "yyyyMMdd") & "\"

    '--- 日付フォルダがなければ作成
    If Not fso.FolderExists(backupFolder) Then
        fso.CreateFolder backupFolder
    End If

    '--- ファイルを1つずつコピー
    Dim f As Object
    Dim count As Long
    count = 0

    For Each f In fso.GetFolder(srcFolder).Files
        fso.CopyFile f.Path, backupFolder & f.Name, True  '← True=上書き許可
        count = count + 1
    Next f

    '--- 古いバックアップフォルダを削除（世代管理）
    Dim subF As Object
    Dim folderDate As Date
    Dim deletedCount As Long
    deletedCount = 0

    For Each subF In fso.GetFolder(destParent).SubFolders
        '--- フォルダ名が "backup_YYYYMMDD" 形式か確認
        If Left(subF.Name, 7) = "backup_" And Len(subF.Name) = 15 Then
            On Error Resume Next
            folderDate = CDate( _
                Mid(subF.Name, 8, 4) & "/" & _
                Mid(subF.Name, 12, 2) & "/" & _
                Mid(subF.Name, 14, 2))
            On Error GoTo 0

            '--- 保持日数を超えていたら削除
            If folderDate > 0 And Date - folderDate > keepDays Then
                fso.DeleteFolder subF.Path, True
                deletedCount = deletedCount + 1
            End If
        End If
    Next subF

    '--- 完了メッセージ
    Dim msg As String
    msg = count & " 件のファイルをバックアップしました。" & vbCrLf & _
          "保存先: " & backupFolder

    If deletedCount > 0 Then
        msg = msg & vbCrLf & vbCrLf & _
              deletedCount & " 個の古いバックアップフォルダを削除しました（" & _
              keepDays & "日超過）。"
    End If

    MsgBox msg, vbInformation

    Set fso = Nothing

End Sub

書き換えポイント

変数	説明	初期値
`srcFolder`	バックアップ元のフォルダパス	`"C:\Users\tanaka\Documents\品質データ"`
`destParent`	バックアップ先の親フォルダパス	`"C:\Users\tanaka\Documents\品質データ_backup"`
`keepDays`	バックアップを保持する日数	`30`

コードの流れ

FSO生成: CreateObject で参照設定なしで使える
フォルダ存在確認: バックアップ元がなければエラー。保存先がなければ自動作成
日付フォルダ作成: backup_20260307 形式で自動作成
ファイルコピー: fso.CopyFile で1ファイルずつコピー
世代管理: サブフォルダを巡回し、フォルダ名から日付を解析。keepDaysを超えたフォルダを削除
完了メッセージ: コピー件数と削除件数を表示

バックアップマクロをボタン（「マクロをボタン1つで実行する方法」）に割り当てれば、毎日ボタン1つでバックアップが完了する。

—

よくある落とし穴5選

1. パスの末尾に「\」がなくてエラーになる

原因: "C:\data" と "C:\data\" では FileCopy や Dir の挙動が変わる。末尾の \ がないと正しくパスを組み立てられない。

対策: コード内で If Right(path, 1) <> "\" Then path = path & "\" を入れて自動補完している。

2. バックアップ先のフォルダが存在せずエラーになる

自分もこれでハマった。バックアップ先のパスをタイプミスして、存在しないフォルダにコピーしようとしてエラーが出た。MkDirで日付フォルダを自動作成する方式に変えて解決した。

対策: 最小版では Dir で親フォルダの存在を確認。実務版では fso.FolderExists + fso.CreateFolder で自動作成している。

3. 同じ日に2回実行するとファイルが上書きされる

原因: 日付フォルダが同じ名前（例: backup_20260307）になるため、2回目の実行で同名ファイルが上書きされる。

対策: 1日1回のバックアップなら問題ない。1日に複数回実行する場合は、フォルダ名に時刻を追加する："backup_" & Format(Now, "yyyyMMdd_HHmmss")

4. サブフォルダ内のファイルがコピーされない

原因: Dir も fso.GetFolder(path).Files も、直下のファイルのみを対象とする。サブフォルダ内のファイルは対象外。

自分も最初、サブフォルダにある重要なファイルがバックアップされていないことに1ヶ月後に気づいた。バックアップしたつもりが半分しかコピーされていなかった。それ以来、バックアップ元のフォルダ構成を事前に確認するようにしている。フォルダ内のファイル構成を確認するには「【VBA】フォルダ内のファイル一覧を自動取得する方法」が便利。

対策: サブフォルダも含めたい場合は再帰処理が必要。この記事のコードは「直下のファイルだけ」を対象にしている。

5. 世代管理の削除でバックアップが全部消えた

原因: keepDays を 0 に設定すると、今日のバックアップ以外がすべて削除される。

対策: keepDays は7以上を推奨。実務版コードでは削除前に日付を正確にチェックしている。心配なら削除処理の前に MsgBox で確認ダイアログを追加するとよい。

VBAのバックアップでファイルがコピーされないときの対処法

「マクロを実行したのにバックアップフォルダが空のまま」という場合、原因はフォルダパスの末尾に \ が付いていないか、パス自体が存在しないことだ。エクスプローラーでパスをコピーし、末尾に \ を追加してコード内の folderPath に貼り付ければ解決する。

VBAの世代管理で古いバックアップが削除されないときの対処法

「古いフォルダが残ったままで削除されない」という場合、原因はバックアップフォルダ名に日付以外の文字列が混在しており、日付の判定が正しく動作していないことだ。フォルダ名を backup_yyyymmdd 形式に統一し、Format(Date - keepDays, "yyyymmdd") で削除対象を判定すれば正確に動作する。

—

FAQ

Q1: Excelファイルだけをバックアップしたい

Dir の引数を変更する：


fileName = Dir(srcFolder & "*.xlsx")   '← Excelファイルだけ

実務版（FSO）の場合は、ループ内で拡張子をチェックする：


For Each f In fso.GetFolder(srcFolder).Files
    If LCase(fso.GetExtensionName(f.Name)) = "xlsx" Then
        fso.CopyFile f.Path, backupFolder & f.Name, True
        count = count + 1
    End If
Next f

Q2: バックアップ元とバックアップ先を同じフォルダにしたい

同じフォルダ内にサブフォルダとして日付フォルダを作ることは可能。ただし、日付フォルダ自体がバックアップ対象になる問題がある。destParent は別のフォルダにするのが無難。

Q3: 大量のファイルがあると時間がかかる

100件程度なら数秒で完了する。1000件を超える場合は、Application.StatusBar で進捗を表示するとよい：


Application.StatusBar = count & " / " & totalFiles & " 件コピー中..."
' ループ終了後にリセット
Application.StatusBar = False

Q4: ファイルの削除を自動化したい

古いファイルの削除は「【VBA】古いファイルを自動削除する方法」で詳しく解説している。バックアップの世代管理とは別に、不要ファイルの定期削除にも使える。

Q5: ボタン1つでバックアップを実行したい

「【VBA】マクロをボタン1つで実行する方法」で BackupFilesAdvanced をボタンに割り当てる。

—

まとめ

FileCopy + MkDir + Dir で日付フォルダに自動バックアップできる（最小版）
FSO の CopyFile + DeleteFolder で世代管理（古いバックアップ自動削除）もできる（実務版）
パスの末尾 \ の有無と、フォルダの存在確認が落とし穴の定番
バックアップは「忘れたときに限って事故が起きる」。自動化して安心を手に入れる

【VBA】古いファイルを自動削除する方法 — 不要ファイルの定期削除はこちら。バックアップ世代管理と使い分け
【VBA】ファイルを別フォルダにコピー・移動する方法 — ファイルコピーの基本に戻りたい場合
【VBA】マクロをボタン1つで実行する方法 — バックアップマクロをボタンに割り当て

—

次にやりたくなること

【VBA】フォルダ内のファイル一覧を自動取得する方法 — バックアップ元のフォルダ構成を事前に確認したい場合に。サブフォルダの漏れ防止に役立つ
【VBA】古いファイルを自動削除する方法 — バックアップの世代管理とは別に、不要ファイルの定期削除を自動化したい場合に
【VBA】ファイルを別フォルダにコピー・移動する方法 — バックアップだけでなく、ファイルの振り分け・整理も自動化したい場合に

—

この記事でできること

完成イメージ（Before / After）

どんな場面で使う？

実行前の準備

バックアップ元のフォルダパスを確認する

バックアップ先の親フォルダを決める

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

手順（コピペ → 実行まで約5分）

VBE（コードを書く画面）を開く

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

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

コード（最小版）– 指定フォルダを日付フォルダにバックアップ

書き換えポイント

コードの流れ

コード（実務版）– 古いバックアップを自動削除（世代管理）

書き換えポイント

コードの流れ

よくある落とし穴5選

1. パスの末尾に「\」がなくてエラーになる

2. バックアップ先のフォルダが存在せずエラーになる

3. 同じ日に2回実行するとファイルが上書きされる

4. サブフォルダ内のファイルがコピーされない

5. 世代管理の削除でバックアップが全部消えた

VBAのバックアップでファイルがコピーされないときの対処法

VBAの世代管理で古いバックアップが削除されないときの対処法

FAQ

Q1: Excelファイルだけをバックアップしたい

Q2: バックアップ元とバックアップ先を同じフォルダにしたい

Q3: 大量のファイルがあると時間がかかる

Q4: ファイルの削除を自動化したい

Q5: ボタン1つでバックアップを実行したい

まとめ

関連記事

次にやりたくなること

コメント