【Excel VBA】バックアップを取るマクロ

2022年7月31日2023年8月16日

当ページのリンクには広告が含まれている可能性があります。

こんにちは、ユーキです。

今回は、バックアップを取るマクロについて紹介します。

Excelは1つ前のファイルをバックアップする機能もありますが、1世代しか保存してくれません。バックアップを取るマクロを自分で作ってみたいと思います。

バックアップ機能作成

バックアップを取るといっても難しいことは行いません。保存する直前に、編集中のブックをコピーするだけです。

では、コードを書いてみましょう。

保存時処理

まず、保存前イベントに処理を追加します。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    '処理を追加
End Sub

ファイルをコピー

ファイルのコピーには、Scripting.FileSystemObjectオブジェクトのCopyFileメソッドを使用します。

CopyFileメソッドは、対象ファイルと、コピー先を指定します。

対象ファイルは、「ThisWorkbook.Path & “\” & ThisWorkbook.Name」で取得可能です。

コピー先の指定は、対象ファイルのサブフォルダ「backup」フォルダとします。
注意：コピー先のフォルダはあらかじめ作成しておく前提となります。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile ThisWorkbook.Path & "\" & ThisWorkbook.Name, ThisWorkbook.Path & "\backup\"
End Sub

コピー先のファイル名変更

上記の処理だと、1世代しか保存できないので、保存先のファイルに日付をつけたいと思います。

末尾に日付をつけるのであれば簡単ですが、それだと使い勝手が悪いので、拡張子の前に日付を入れるようにします。拡張子なしのファイル名と、ファイルの拡張子と、日付を取得します。

    '拡張子なしのファイル名取得
    Dim fileNm As String
    fileNm = fso.GetBaseName(ThisWorkbook.Path & "\" & ThisWorkbook.Name)
    'ファイルの拡張子
    Dim extName As String
    extName = fso.GetExtensionName(ThisWorkbook.Path & "\" & ThisWorkbook.Name)
    
    '日付文字列
    Dim timeTx As String
    timeTx = Format(Now(), "yyyyMMddhhnnss")

完成コード

上記のコードを組み合わせると、以下になります。

これで保存する度に、編集前のファイルをbackupフォルダに保存できるようになりました。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    '拡張子なしのファイル名取得
    Dim fileNm As String
    fileNm = fso.GetBaseName(ThisWorkbook.Path & "\" & ThisWorkbook.Name)
    'ファイルの拡張子
    Dim extName As String
    extName = fso.GetExtensionName(ThisWorkbook.Path & "\" & ThisWorkbook.Name)
    '日付文字列　年月日時分秒を取得
    Dim timeTx As String
    timeTx = Format(Now(), "yyyyMMddhhnnss")
    fso.CopyFile ThisWorkbook.Path & "\" & ThisWorkbook.Name, ThisWorkbook.Path & "\backup\" & fileNm & "_" & timeTx & "." & extName
End Sub