VBS for backup while saving word file

I have an excel that each time I save one more file is saved separately with the name of the respective file, to which is added the date and time of the save in the file name.
I use the macro below for this.
The same thing I would like to do for a word file, but I can't.
Please help.
Thanks.

Option Explicit

Private Sub Workbook_Open()
    Application.Caption = "Microsoft Excel AutoBackup"
End Sub
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Debug.Print Split(ThisWorkbook.Name, ".")(1)
    Dim MyFilePath$, Extension$
    MyFilePath = ("C:\Documents\Backup\")
    Extension = Left(ThisWorkbook.Name, Len _
    (ThisWorkbook.Name) - 4) & " Backup"
    
    On Error Resume Next '<< folder exists
    MkDir MyFilePath & Extension '<< create folder
     'save current version of this book in the folder
    ActiveWorkbook.SaveCopyAs Filename:=MyFilePath & _
    Extension & "\" & Extension & _
    (Format(Now, " yyyy-MM-dd, HH.mm.ss.")) & _
    Split(ThisWorkbook.Name, ".")(1)
    
End Sub

It's not clear from your question but I am going to assume you want to do this for a Word file as a Word macro, not an Excel macro.

One issue is that Excel has a SaveCopy method but Word does not. I have solved this problem in the past by saving the document, saving it with the new name, then re-opening the original. Also, the model in Word for handling a Save event is more complex than how it works in Excel. You can read that Microsoft page for details on capturing the event, then you can call the Sub below from it.

A simpler option might be to use the Windows file system to make the copy, rather than saving as a copy. I have not tested this but it illustrates the approach.

Private Sub SaveBackup()

    Dim MyFilePath As String, Extension As String
    
    MyFilePath = ("C:\Documents\Backup\")
    
    Extension = Left(ThisDocument.Name, Len(ThisDocument.Name) - 4) & " Backup"
    
    On Error Resume Next '<< folder exists
    MkDir MyFilePath & Extension '<< create folder
     'save current version of this book in the folder
    ActiveDocument.Save ' save first to make sure the copy is the current version
    FileCopy Source:=ActiveDocument.Name, _
             Destination:=MyFilePath & Extension & "\" & Extension & Format(Now, " yyyy-MM-dd, HH.mm.ss.") & Split(ThisDocument.Name, ".")(1)

End Sub

I did test this and it turns out FileCopy will fail if the source file is open. I was able to get this to work. You will need to research how to capture the Save event in the link I provided above.

Private Sub SaveBackup()

    Dim MyFilePath As String, Extension As String
    Dim FS As Object
    Set FS = CreateObject("Scripting.FileSystemObject")
    
    MyFilePath = ("C:\Documents\Backup\")
    
    Extension = Left(ThisDocument.Name, Len(ThisDocument.Name) - 4) & " Backup"
    
    On Error Resume Next '<< folder exists
    MkDir MyFilePath & Extension '<< create folder
     'save current version of this book in the folder
    ActiveDocument.Save ' save first to make sure the copy is the current version
    FS.CopyFile ActiveDocument.Name, _
                     MyFilePath & Extension & "\" & Extension & Format(Now, " yyyy-MM-dd, HH.mm.ss.") & Split(ThisDocument.Name, ".")(1), _
                     True
    Set FS = Nothing

End Sub