ファイルのバックアップ簡単確実に実施できるマクロ

Private Sub sample()
    ' 現在のブックを日付付きでバックアップするサブルーチンを呼び出す
    datedBackupToFolder ThisWorkbook
End Sub

'*******************************
'* 指定フォルダーに日付入りでバックアップ。OneDriveにも対応。
'* wb：開いているWorkbook（対象のブック）を指定
Sub datedBackupToFolder(ByVal wb As Workbook)

    Dim backupPath As String           ' バックアップ先のフルパスを格納する変数
    Dim folderName As String           ' バックアップ用フォルダーの名前を格納
    Dim suffix As String               ' バックアップファイル名に付加する日付の文字列
    
    ' バックアップ先フォルダーの名前を指定
    folderName = "バックアップ用"
    
    ' 日付をフォーマットして、バックアップファイル名の末尾に追加する文字列を作成
    ' フォーマット例："_202410071530"（YYYYMMDDHHNN形式）
    suffix = Format(Now, "_yyyymmddhhnn")
    
    ' バックアップフォルダーのフルパスを取得する
    backupPath = getFolderPathFromBook(wb) & "\" & folderName
    
    ' 指定されたパスにフォルダーがない場合は作成する処理
    backup.makeFolder backupPath
    
    ' バックアップファイルのフルパスを作成する
    ' ブック名の拡張子を除いた部分に日付を追加して、保存ファイル名を作成
    backupPath = backupPath & "\" & Split(wb.Name, ".")(0) & suffix
    
    ' マクロが含まれるブックの場合は「.xlsm」、含まれない場合は「.xlsx」として保存
    If wb.HasVBProject = True Then
        ' マクロが含まれている場合
        backupPath = backupPath & ".xlsm"
    Else
        ' マクロが含まれていない場合
        backupPath = backupPath & ".xlsx"
    End If
    
    ' ブックを指定されたパスに「コピー保存」する
    ' SaveCopyAs メソッドは元のブックを上書きせずに複製保存する
    wb.SaveCopyAs backupPath

End Sub

'*******************************
'* 指定されたパスにフォルダーを作成する
'* path：作成するフォルダーのフルパスを指定
Sub makeFolder(path As String)

    Dim fso As Object                    ' FileSystemObjectを操作するためのオブジェクトを宣言
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 指定されたパスにフォルダーが存在しない場合は、新しくフォルダーを作成する
    If Not fso.FolderExists(path) Then
        fso.CreateFolder path
    End If

End Sub