Excel VBA 逆引き集 | バックアップ自動生成

Excel VBA
スポンサーリンク

ねらい：バックアップを「自動で」「安全に」作る基盤

大事なブックやデータを壊さない最短ルートは、変更前に必ずバックアップを残すことです。ここでは初心者でも使えるテンプレを揃え、「保存のたびに自動バックアップ」「変更前のスナップショット」「世代ローテーション」「CSVエクスポート」「復元」まで、現場で使える形で深掘りします。

  • 目的: 事故防止、監査証跡、簡単復元
  • 基本方針:
    • 安全な命名: 日付時刻スタンプで重複回避
    • 保存先の保証: フォルダがなければ自動生成
    • ローテーション: 古いバックアップを自動削除
    • トリガー: 保存時/終了時/ボタン/スケジュールで自動化

基本テンプレ：ブックの自動バックアップ（SaveCopyAs）

Sub BackupWorkbook()
    Dim folder As String: folder = "C:\Backup\"
    Dim base As String: base = "MyBook"
    Dim stamp As String: stamp = Format(Now, "yyyy-mm-dd_HHNNSS")
    Dim path As String: path = folder & base & "_" & stamp & ".xlsm" ' マクロ有り
    
    EnsureFolder folder
    ThisWorkbook.SaveCopyAs path
    MsgBox "バックアップ作成: " & path
End Sub

Private Sub EnsureFolder(ByVal folderPath As String)
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(folderPath) Then fso.CreateFolder folderPath
End Sub
VB
  • 重要ポイント（深掘り）:
    • SaveCopyAs: 現在のブックを「そのまま」別名で保存（開いているファイルはそのまま）。手戻りが簡単。
    • 時刻スタンプ: yyyy-mm-dd_HHNNSSで一意名。上書き事故が起きない。
    • 拡張子一致: マクロ有りなら .xlsm を使う。

変更前バックアップ（Write-Ahead風）：保存時に自動バックアップ

' ThisWorkbook モジュールに配置
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, ByVal Cancel As Boolean)
    On Error Resume Next
    Call BackupWorkbook
    On Error GoTo 0
End Sub
VB
  • 重要ポイント（深掘り）:
    • BeforeSave: ユーザーが保存する「直前」に必ずバックアップ。ヒューマンエラーをカバー。
    • 失敗しても保存は続行: エラーは握りつぶしでUXを保つ（ログ連携は後述が推奨）。

範囲/シートのCSVバックアップ（UTF-8）

Sub BackupSheetAsCsv()
    Dim ws As Worksheet: Set ws = Worksheets("Input")
    Dim rng As Range: Set rng = ws.Range("A1").CurrentRegion
    
    Dim folder As String: folder = "C:\Backup\csv\"
    Dim base As String: base = "Input"
    Dim stamp As String: stamp = Format(Now, "yyyy-mm-dd_HHNNSS")
    Dim path As String: path = folder & base & "_" & stamp & ".csv"
    
    EnsureFolder folder
    SaveRangeCsv rng, path
    MsgBox "CSVバックアップ: " & path
End Sub

Private Sub SaveRangeCsv(ByVal rng As Range, ByVal path As String)
    Dim st As Object: Set st = CreateObject("ADODB.Stream")
    st.Type = 2: st.Charset = "UTF-8": st.Open
    Dim r As Long, c As Long, rows As Long, cols As Long
    rows = rng.Rows.Count: cols = rng.Columns.Count
    For r = 1 To rows
        Dim line As String: line = ""
        For c = 1 To cols
            Dim s As String: s = CStr(rng.Cells(r, c).Value)
            s = Replace(s, """", """""")
            line = line & IIf(c > 1, ",", "") & """" & s & """"
        Next
        st.WriteText line & vbCrLf
    Next
    st.SaveToFile path, 2
    st.Close
End Sub
VB
  • 重要ポイント（深掘り）:
    • UTF-8明示: 日本語の文字化けを防ぐ。
    • CurrentRegion: 見出しから連続領域を一発取得。シンプルで実用的。

ローテーション：古いバックアップを自動削除（最大N世代）

Sub RotateBackups(ByVal folder As String, ByVal base As String, Optional ByVal keepN As Long = 10)
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(folder) Then Exit Sub
    
    Dim files As Object: Set files = CreateObject("System.Collections.ArrayList")
    Dim f As Object
    For Each f In fso.GetFolder(folder).Files
        If InStr(1, f.Name, base & "_", vbTextCompare) = 1 Then
            files.Add f
        End If
    Next
    If files.Count <= keepN Then Exit Sub
    
    ' 旧い順に削除（DateLastModifiedでソート）
    files.Sort
    Dim i As Long
    For i = 0 To files.Count - keepN - 1
        On Error Resume Next
        files(i).Delete
        On Error GoTo 0
    Next
End Sub
VB
  • 重要ポイント（深掘り）:
    • 世代管理: ディスク肥大を防ぐ。「最新N件だけ残す」が現場で安定。
    • 命名規則: base_yyyy-mm-dd_HHNNSS 前提で対象を絞る。別業務は別baseに。

退避リネーム＋新規保存（上書き事故を根絶）

Sub SafeReplaceReport()
    Dim folder As String: folder = "C:\Reports\"
    Dim main As String: main = folder & "月次レポート.xlsm"
    
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    EnsureFolder folder
    
    If fso.FileExists(main) Then
        Dim stamp As String: stamp = Format(Now, "yyyymmdd_HHNNSS")
        Dim bak As String: bak = folder & "月次レポート_" & stamp & ".xlsm"
        fso.MoveFile main, bak
    End If
    
    ThisWorkbook.SaveCopyAs main
    MsgBox "旧版を退避→最新版を配置しました。"
End Sub
VB
  • 重要ポイント（深掘り）:
    • 移動してから保存: 旧版を安全に残して最新版を明確化。ユーザーは常に「同じパス」を参照。
    • 命名の一貫性: 人・システム双方で管理しやすい。

自動トリガー：終了時バックアップ＋毎日指定時刻にバックアップ

' ThisWorkbook モジュール
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    Call BackupWorkbook
    On Error GoTo 0
End Sub

' 標準モジュール
Sub ScheduleDailyBackup()
    Dim nextTime As Date
    nextTime = Date + TimeValue("23:00:00") ' 毎日23時
    Application.OnTime EarliestTime:=nextTime, Procedure:="BackupWorkbook", Schedule:=True
    MsgBox "毎日23時にバックアップを予約しました。Excelを起動し続ける場合に有効です。"
End Sub

Sub CancelDailyBackup()
    On Error Resume Next
    Application.OnTime EarliestTime:=Date + TimeValue("23:00:00"), Procedure:="BackupWorkbook", Schedule:=False
    On Error GoTo 0
End Sub
VB
  • 重要ポイント（深掘り）:
    • BeforeClose: 終了前の保険。
    • OnTime: Excel起動中のみ有効。常時運用が前提。起動しない日は実行されない点に注意。

復元テンプレ：最新バックアップを簡単復元

Sub RestoreLatestBackup()
    Dim folder As String: folder = "C:\Backup\"
    Dim base As String: base = "MyBook"
    Dim latestPath As String: latestPath = FindLatestBackup(folder, base)
    If latestPath = "" Then
        MsgBox "バックアップが見つかりません。": Exit Sub
    End If
    Workbooks.Open latestPath
    MsgBox "最新バックアップを開きました: " & latestPath
End Sub

Private Function FindLatestBackup(ByVal folder As String, ByVal base As String) As String
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(folder) Then Exit Function
    Dim newest As Object, f As Object
    For Each f In fso.GetFolder(folder).Files
        If InStr(1, f.Name, base & "_", vbTextCompare) = 1 Then
            If newest Is Nothing Then
                Set newest = f
            ElseIf f.DateLastModified > newest.DateLastModified Then
                Set newest = f
            End If
        End If
    Next
    If Not newest Is Nothing Then FindLatestBackup = newest.Path
End Function
VB
  • 重要ポイント（深掘り）:
    • 最新選択: DateLastModifiedで素直に選ぶ。
    • 復元動線: 「最新を開く→必要なら本番にコピー」で事故なく戻せる。

例題で練習（貼って試せる）

  • 例1（手動バックアップ）:
    • 狙い: SaveCopyAsの動作確認。
    • 手順: BackupWorkbook → 指定フォルダに .xlsm が生成される。
  • 例2（保存時に自動）:
    • 狙い: BeforeSaveトリガーの体感。
    • 手順: 何か編集→保存→バックアップが生成される。
  • 例3（CSVバックアップ）:
    • 狙い: 範囲をUTF-8で保存。
    • 手順: BackupSheetAsCsv → CurrentRegionがCSVに。
  • 例4（ローテーション）:
    • 狙い: 最新10件を残して古いものを削除。
    • 手順: バックアップを連続作成→RotateBackupsで整備。
  • 例5（復元）:
    • 狙い: 最新バックアップを開く。
    • 手順: RestoreLatestBackup → 直近のファイルが開く。

実務の落とし穴と対策（ここが肝）

  • 保存先が存在しない:
    • 対策: EnsureFolderで必ず作成してから保存。
  • 拡張子/フォーマット不一致:
    • 対策: .xlsm＋マクロ有効、.xlsx＋マクロ無効で使い分け。
  • バックアップ肥大化:
    • 対策: RotateBackups（世代管理）を定期的に実行。
  • OnTimeの誤解（Excel未起動時は実行されない）:
    • 対策: 保存時/終了時のトリガー併用。夜間は別の運用（タスクスケジューラ＋VBS）も検討。
  • パスやファイル名の禁則:
    • 対策: ベース名は英数＋-/_。ユーザー入力は安全化（禁則文字置換）を行う。

スターター手順（最短導入）

  • 手順1: BackupWorkbook と EnsureFolder を標準モジュールに貼る。
  • 手順2: ThisWorkbook の BeforeSave/BeforeClose にバックアップ呼び出しを追加。
  • 手順3: CSVバックアップ（必要なシート/範囲）を SaveRangeCsv で用意。
  • 手順4: RotateBackups を定期実行して世代管理。
  • 手順5: RestoreLatestBackup を用意して「すぐ戻せる」動線を確保。

スポンサーリンク
タイトルとURLをコピーしました