【ExcelVBA】マクロブックを開いたときにバックアップファイルを自動保存する方法

マクロ付きブックを開いたときに、自ブックのコピーをバックアップフォルダへ保存する方法について説明します。

マクロを長期間開発していたりするとある日突然ファイルが壊れてしまって、そんなときに直近までのバックアップを取っておけばよかったなぁと後悔することも…。

そんな苦い経験からファイルを開く度に自動でバックアップを取っておけばいいじゃん、ということで機能を追加しました。

クリックできる見出し

自ブックのバックアップファイルを作成して保存する方法
バックアップファイルが増え続けないように自動で削除する機能を追加
※コードのコピー利用について

自ブックのバックアップファイルを作成して保存する方法

マクロ処理を標準モジュールに書いて、ボタンなど任意のタイミングでバックアップファイルを作成することもできますが、今回はファイルを開く度に自動でバックアップファイルを作成する方法について説明します。

ファイルを開いたときの処理で実施したいので、標準モジュールではなくてThisWorkbookオブジェクトのOpenイベントに記述していきます。

サンプルマクロで実行している内容
①自ブックがあるフォルダ内にbackupフォルダを作成する
　（すでにある場合は作成しない）
②バックアップファイルのファイル名を作成する
　（ファイル名の後ろに日付8桁の数字を付けて保存します。）
③自ブックをコピーしてbackupフォルダに保存する

Private Sub Workbook_Open()

    Dim fs As Object
    Dim BackupFileName As String
    
    'FileSystemObjectのインスタンスを作成
    Set fs = CreateObject("Scripting.FileSystemObject")

    'backupフォルダがない場合
    If Dir(ThisWorkbook.Path & "\backup", vbDirectory) = "" Then
    
        'backupフォルダを作成する…⓵
        MkDir ThisWorkbook.Path & "\backup"
        
    End If
    
    'バックアップファイル名を変数にセット（自ブックのファイル名+日付8桁）…⓶
    BackupFileName = Replace(ThisWorkbook.Name, ".xlsm", "") & "_" & Format(Now, "yyyymmdd")
    
    '自ブックをコピーしてbackupフォルダに保存する…⓷
    fs.CopyFile ThisWorkbook.FullName, ThisWorkbook.Path & "\backup\" & BackupFileName & "." & fs.GetExtensionName(ThisWorkbook.FullName)
  
    '変数の初期化
    Set fs = Nothing
  
End Sub

マクロを実行するとbackupフォルダが作成されます。（自ブックはsample.xlsm）

backupフォルダ内はこんな感じでバックアップファイルが日付ごとに保存されていきます。
今日は2024/11/3なので今日の日付のファイルが追加されました。

もっと細かく保存したい場合は時間（hhmm）も付けて保存すると良いと思います。

バックアップファイルが増え続けないように自動で削除する機能を追加

バックアップファイルを保存することはできましたが、このままでは日々ファイルが増え続けてしまいます。

直近何日か分は取っておきたいけど、あんまり古いのは要らないから自動で削除したいなという場合は自動で削除する機能も付けておくと便利です。

↓のサンプルマクロではバックアップファイルを作成したあとに、backupフォルダ内のファイルを調べて、今日の日付から10日以上前のファイル名のファイルは削除をしています。

サンプルマクロで実行している内容
①自ブックがあるフォルダ内にbackupフォルダを作成する
　（すでにある場合は作成しない）
②バックアップファイルのファイル名を作成する
　（ファイル名の後ろに日付8桁の数字を付けて保存します。）
③自ブックをコピーしてbackupフォルダに保存する
④フォルダ内のファイルをループする
⑤ファイル名の日付部分が今日の日付より10日以上前の場合、ファイルを削除する

Private Sub Workbook_Open()
    
　　Dim fs As Object
    Dim BackupFileName As String
    Dim TargetFile As Object
    
    Set fs = CreateObject("Scripting.FileSystemObject")

    'backupフォルダがない場合
    If Dir(ThisWorkbook.Path & "\backup", vbDirectory) = "" Then
    
        'backupフォルダを作成する…⓵
        MkDir ThisWorkbook.Path & "\backup"
        
    End If
    
    'バックアップファイル名を変数にセット（自ブックのファイル名+日付）…⓶
    BackupFileName = Replace(ThisWorkbook.Name, ".xlsm", "") & "_" & Format(Now, "yyyymmdd")
    
    '自ブックをコピーしてbackupフォルダに保存する…⓷
    fs.CopyFile ThisWorkbook.FullName, ThisWorkbook.Path & "\backup\" & BackupFileName & "." & fs.GetExtensionName(ThisWorkbook.FullName)
  
    'フォルダ内のファイルを繰り返す…⓸
    For Each TargetFile In fs.GetFolder(ThisWorkbook.Path & "\backup\").Files
    
        'ファイル名の日付が10日以上前の場合
        If Val(Right(Replace(TargetFile.Name, ".xlsm", ""), 8)) <= Val(Format(Now - 10, "yyyymmdd")) Then
       
             'ファイルを削除する…⓹
             TargetFile.Delete
             
        End If
        
    Next TargetFile
  
    '変数の初期化
    Set fs = Nothing
    Set TargetFile = Nothing

End Sub

マクロを実行すると今日の日付（2024/11/3）より10日以上前（2024/10/24以前）のファイルは削除されます。