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

VBA
2026.03.16
スポンサーリンク

Contents

スポンサーリンク

この記事でできること

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

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

完成イメージ（Before / After）

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

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

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

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

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

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

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

実行前の準備

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

ボタンに割り当てれば毎回Alt+F8を押さなくて済む。方法は マクロをボタン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"

コードの流れ

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

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

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

実務ではバックアップが溜まり続けてディスクを圧迫する。「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

コードの流れ

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

バックアップマクロをボタン（マクロをボタン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 も、直下のファイルのみを対象とする。サブフォルダ内のファイルは対象外。

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

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

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

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

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: ファイルの削除を自動化したい

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

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

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

まとめ

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

関連記事

次にやりたくなること

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

「バックアップ対象を拡張子やファイル名で絞りたい」「複数フォルダを一度にバックアップしたい」「ネットワークドライブにバックアップしたい」など、業務に合わせたカスタマイズが必要な場合は、ココナラで相談できる。

相談時に伝えると話が早い情報:

  • Excel のバージョン / OS
  • バックアップ元のフォルダパスと構成（サブフォルダの有無）
  • バックアップ対象のファイル種類と数
  • バックアップの頻度（毎日/毎週/月次）
スポンサーリンク

コメント

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