Private Function DateFormat(sName As String) As String
©Graham Mayor - https://www.gmayor.com - Last updated - 04 Apr 2021 
Dim sDate As String
    If InStr(1, sName, "(") > 0 Then
        sDate = Split(sName, "(")(1)
        sDate = Split(sDate, " ")(1)
        sDate = Split(sDate, ")")(0)
        If InStr(1, sDate, ".") > 0 Then
            DateFormat = "mm.dd.yy" 'note lower case!
        Else
            DateFormat = "mmddyy"
        End If
    Else
        DateFormat = "mm.dd.yy"
    End If
End Function

Sub SaveNewVersion_Word()
'PURPOSE: Save file, if already exists add a new version indicator to filename
'Graham Mayor - https://www.gmayor.com - Last updated - 04 Apr 2021

Dim sPath As String
Dim sName As String, sNewName As String
Dim sExt As String
Dim sVer As String
Dim vVer As Variant
Dim sDate As String
Dim sInitials As String
Dim sFormat As String

    sInitials = Application.UserInitials
    sPath = ActiveDocument.path
    If sPath = "" Then GoTo NotSavedYet
    sPath = sPath & "\"
    sName = ActiveDocument.Name
    sFormat = DateFormat(sName)
    sDate = Format(Date, sFormat) 'Format the date
    sExt = Right(sName, Len(sName) - InStrRev(sName, ".") + 1)
    sNewName = Trim(Split(sName, "(")(0))
    sVer = sNewName
    vVer = Split(sVer, Chr(32))
    sVer = onlyDigits(CStr(vVer(UBound(vVer))))
    sName = Replace(sNewName, sVer, Format(sVer + 1, "00"))
    'MsgBox sName & " (" & sInitials & Chr(32) & sDate & ")" & sExt
    ActiveDocument.SaveAs2 sPath & sName & " (" & sInitials & Chr(32) & sDate & ")" & sExt
    'New version saved
    MsgBox "New file version saved (" & Format(sVer + 1, "00") & ")"
lbl_Exit:
    Exit Sub
    'Error Handler
NotSavedYet:
    MsgBox "This file has not been initially saved. " & _
           "Cannot save a new version!", vbCritical, "Not Saved To Computer"    '
    GoTo lbl_Exit
End Sub