ExcelVBAでファイルを閉じるとバックアップを作成・保存する

ExcelのVBAでファイルを閉じる時に自動でバックアップを保存するコードを作成しました。

作成背景

仕事でWBSをExcelで作成してプロジェクト管理をしているのですが、このWBSが非常に大切でマメにバックアップを取りたいと思いました。

毎回手動でコピーするのも面倒だし、ただ単にコピーするとファイル名が重複してうまくいきません。

そこで、ファイル名に日付を追加した上で同ディレクトリ内の「99_Backup」ディレクトリにファイルをコピー・保存するようにしました。

コード

コードはこちらです。

Private Sub Workbook_BeforeClose(cancel As Boolean)
    
    On Error Resume Next
    Application.DisplayAlerts = False
    
    Dim thisPath As String  'For obtaining path of this file
    Dim FileDate As String  'For date and time to make a new file name
    Dim NewFileName As String   'For new name
    
    thisPath = ThisWorkbook.Path
    FileDate = Format(Now, "yyyymmdd-hhnn")
    
    Dim OriginalFileName As String
    OriginalFileName = ThisWorkbook.Name
    
    Dim Pos As Integer
    Pos = InStr(OriginalFileName, ".")
    
    NewFileName = Left(OriginalFileName, Pos - 1)
  
    NewFileName = NewFileName & "_bkup" & FileDate
        
    'Check if 99_Backup folder exists
    Dim result
    Dim backup_dir
    backup_dir = thisPath & "\99_Backup"
    result = Dir(backup_dir, vbDirectory)
    If result = "" Then
        'Not exist, so create
        MkDir backup_dir
    End If
        
    'Saving this foder as the new name
    ThisWorkbook.SaveAs Filename:=thisPath & "\99_Backup\" & NewFileName, FileFormat:=xlOpenXMLWorkbook

    Application.DisplayAlerts = True

End Sub

作成背景

コード

コメントする コメントをキャンセル

コメントするコメントをキャンセル