strName = strName & " " & ActiveDocument.ContentControls(1).Range.Text 'add name from first content control

Sub FileSaveAs()
    ' Run as substitute for FileSave to add date to default document names
    ' Charles Kenyon 2017, 2019, 2020
    ' Appends date to Title Document property when saving
    On Error Resume Next
   
    If Len(ActiveDocument.Path) > 0 Then
      ' The document has already been saved at least once.
      ' Just save and exit the macro.
      ActiveDocument.Save
      Exit Sub
    End If
    '
    '
    Dim strName As String, dlgSave As Dialog
    Dim strPath As String   'Holder for current path
    Let strPath = Application.Options.DefaultFilePath(wdDocumentsPath)
    Set dlgSave = Dialogs(wdDialogFileSaveAs)
    strName = ActiveDocument.BuiltInDocumentProperties("Title").Value 'get name in title
    strName = strName & " " & ActiveDocument.ContentControls(1).Range.Text 'add name from first content control
    strName = strName & " " & Format((Year(Now() + 1) Mod 100), "20##") & "-" & _
        Format((Month(Now() + 1) Mod 100), "0#") & "-" & _
        Format((Day(Now()) Mod 100), "0#") 'add date
    With dlgSave
        .Name = strPath & strName
        .Show
    End With
    '   Reset save path
    Let Application.Options.DefaultFilePath(wdDocumentsPath) = strPath
    '   empty object
    Set dlgSave = Nothing
End Sub

Sub FileSave()
    FileSaveAs
End Sub