ブックを日付付きでバックアップ保存する（SaveCopyAs と Format(Now) の使い方）

どんな場面で使うか

大量の行を削除する、マスタを一括で書き換えるなど、元に戻せない処理を行うマクロでは、実行前にブックのバックアップを取っておくと安心です。マクロで行った変更は Excel の「元に戻す」が使えないため、バックアップがないと、誤った処理に気づいても元の状態に戻せません。

手作業で「名前を付けて保存」をするのは忘れやすく、ファイル名の付け方も人によってばらばらになります。日付と時刻を付けた名前で自動保存する処理を、ほかのマクロの最初に呼び出すようにしておくと、確実にバックアップが残ります。

SaveAs と SaveCopyAs の違い

ブックを別の名前で保存する方法には SaveAs と SaveCopyAs があります。SaveAs は「名前を付けて保存」と同じ動きで、保存後は開いているブック自体が新しいファイルに切り替わります。そのまま作業を続けると、バックアップのつもりで保存したファイルの方を編集してしまうことになります。

SaveCopyAs は、開いているブックはそのままで、現在の内容のコピーだけを別のファイルとして保存します。バックアップの目的にはこちらが適しています。なお、SaveCopyAs は保存形式を変えられないため、拡張子は元のブックと同じにします。

コード

ブックと同じ場所に「backup」フォルダを作り、「元のファイル名_年月日_時分秒.拡張子」の名前でコピーを保存します。日時の書式で分を表すときは、月の「mm」と区別するために「nn」を使っています。

Function BackupThisBook() As Boolean
    Dim folderPath As String, baseName As String, ext As String
    Dim savePath As String, pos As Long

    If ThisWorkbook.Path = "" Then
        MsgBox "ブックが一度も保存されていないため、バックアップできません"
        Exit Function
    End If
    If Left(ThisWorkbook.Path, 4) = "http" Then
        MsgBox "OneDrive・SharePoint 上のブックのため、この方法では保存できません"
        Exit Function
    End If

    folderPath = ThisWorkbook.Path & "\backup"
    If Dir(folderPath, vbDirectory) = "" Then MkDir folderPath

    pos = InStrRev(ThisWorkbook.Name, ".")
    baseName = Left(ThisWorkbook.Name, pos - 1)
    ext = Mid(ThisWorkbook.Name, pos)                  ' 例：.xlsm
    savePath = folderPath & "\" & baseName & "_" & Format(Now, "yyyymmdd_hhnnss") & ext

    On Error GoTo ErrHandler
    ThisWorkbook.SaveCopyAs savePath
    BackupThisBook = True
    Exit Function
ErrHandler:
    MsgBox "バックアップに失敗しました：" & Err.Description
End Function

Sub MainProcess()
    If Not BackupThisBook() Then Exit Sub              ' バックアップできなければ中止
    ' ここに本来の処理（行の削除や一括更新など）を書く
End Sub

上書き確認を消すときの注意

SaveAs で既存のファイルと同じ名前を指定すると「置き換えますか？」という確認が表示されます。これを出さないために Application.DisplayAlerts = False を使う例をよく見かけますが、確認なしで既存のファイルが上書きされるため、大切なファイルを消してしまう危険があります。使う場合は保存の直前だけにして、直後に True へ戻してください。

この記事のように時刻を秒まで含めたファイル名にすれば、同じ名前になることはほとんどなく、上書き確認を消す必要もありません。SaveCopyAs は同名のファイルがあると確認なしで置き換えるため、ファイル名が重ならない工夫が特に大切です。

古いバックアップの整理

毎回バックアップを取るとファイルが増え続けるため、一定期間より古いものを削除する処理を加えることもできます。次の例は、backup フォルダ内で同じブック名から始まり、更新日時が30日より前のファイルを削除します。削除は元に戻せないため、対象の条件は慎重に決め、最初は Kill の行を Debug.Print に置き換えて対象を確認してから使ってください。

Sub CleanOldBackups(ByVal folderPath As String, ByVal baseName As String)
    Dim fileName As String
    fileName = Dir(folderPath & "\" & baseName & "_*")
    Do While fileName <> ""
        If FileDateTime(folderPath & "\" & fileName) < Now - 30 Then
            Kill folderPath & "\" & fileName          ' 30日より古いものを削除
        End If
        fileName = Dir()
    Loop
End Sub

ほかの記事