Option Explicit

Sub FileVerTest()
'Graham Mayor - https://www.gmayor.com - Last updated - 04 Apr 2021
Dim vVer As Variant
Dim sName As String
Dim sVersion As String
    sName = ActiveDocument.Name
    sVersion = Trim(Split(sName, "(")(0))
    vVer = Split(sVersion, Chr(32))
    sVersion = onlyDigits(CStr(vVer(UBound(vVer))))
    MsgBox sVersion
End Sub

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

    sInitials = Application.UserInitials
    sDate = Format(Date, "MM.DD.YY")
    sPath = ActiveDocument.path
    If sPath = "" Then GoTo NotSavedYet
    sPath = sPath & "\"
    sName = ActiveDocument.Name
    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

Private Function onlyDigits(s As String) As String
'https://stackoverflow.com/questions/7239328/how-to-find-numbers-from-a-string#7239408
'modified by Graham Mayor - https://www.gmayor.com - Last updated - 04 Apr 2021
' Variables needed (remember to use "option explicit").   '
Dim retval As String    ' This is the return string.      '
Dim i As Integer        ' Counter for character position. '

' Initialise return string to empty                       '
    retval = ""

    ' For every character in input string, copy digits to     '
    '   return string.                                        '
    For i = 1 To Len(s)
        If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Or Mid(s, i, 1) = "." Then
            retval = retval + Mid(s, i, 1)
        End If
    Next

    ' Then return the return string.                          '
    onlyDigits = retval
End Function