Option Explicit
Sub OpenAs()
Dim s$, strDate$, strPath$, r As Boolean, S1$
s = ActiveDocument.Name
strPath = "d:"
strDate = Format(Now, "yyyy-mm-dd")
    If s Like "*-??-*" Then s = RegExpReplace(s, "\d{2,4}-\d{2}-\d{2,4}", strDate): r = 1
    If Not r Then
      S1 = Split(s, ".")(UBound(Split(s, ".")))
      s = Trim(Left(s, Len(s) - Len(S1) - 1))
      s = s & " " & strDate & "." & S1
    End If
    If Dir(strPath & "\" & s) = "" Then MsgBox "Файл:" & Chr(10) & strPath & "\" & s & " не существует!", vbInformation: Exit Sub
        
        Documents.Open FileName:=strPath & "\" & s
        MsgBox "файл:" & Chr(10) & strPath & "\" & s & " открыт!", vbInformation
End Sub
Sub SaveAs()
Dim s$, strDate$, strPath$, r As Boolean, S1$
s = ActiveDocument.Name
strPath = "d:"
strDate = Format(Now, "yyyy-mm-dd")
    If s Like "*-??-*" Then s = RegExpReplace(s, "\d{2,4}-\d{2}-\d{2,4}", strDate): r = 1
    If Not r Then
      S1 = Split(s, ".")(UBound(Split(s, ".")))
      s = Trim(Left(s, Len(s) - Len(S1) - 1))
      s = s & " " & strDate & "." & S1
    End If
    s = InputBox("Сохранить файл в папке " & vbCr & strPath & vbCr & "как:", , s)
    If Not s = "" Then
        ActiveDocument.SaveAs2 FileName:=strPath & "\" & s
        MsgBox "файл:" & Chr(10) & strPath & "\" & s & " сохранен", vbInformation
    End If
End Sub
Private Function RegExpReplace(ByVal WhichString As String, _
                        ByVal Pattern As String, _
                        Optional ByVal ReplaceWith As String = " ", _
                        Optional ByVal IsGlobal As Boolean = True, _
                        Optional ByVal IsCaseSensitive As Boolean = True) As String
'Функция по регулярному выражению (маске) возвращает результат
'Declaring the object
Dim objRegExp As Object
'Initializing an Instance
Set objRegExp = CreateObject("vbscript.regexp")
'Setting the Properties
objRegExp.Global = IsGlobal
objRegExp.Pattern = Pattern
objRegExp.IgnoreCase = Not IsCaseSensitive
'Execute the Replace Method
RegExpReplace = objRegExp.Replace(WhichString, ReplaceWith)
End Function