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

Sub FieldResultFillIn()
    ' Charles Kenyon  30 Sept. 2020
    Dim strResult As String
    Dim oField As Field
    On Error GoTo ErrorHandler
    For Each oField In ActiveDocument.Fields
        If oField.Type = wdFieldFillIn Then
            Let strResult = oField.Result
            Exit For
        End If
    Next oField
    If strResult = "" Then
        MsgBox "No Fill-In Fields in this document."
    Else
        MsgBox "The text in the first Fill-In field in the document is:" & vbCrLf & strResult
    End If
    GoTo Cleanup
ErrorHandler:
    MsgBox "There do not appear to be any fields in this document."
Cleanup:
    Set oField = Nothing
    On Error GoTo -1
End Sub

Sub FileSaveAs()
    ' Run as substitute for FileSave to add bookmark contents 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
    '
    On Error GoTo BookMarkMissing
    '
    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)
    Let strName = ActiveDocument.Bookmarks("Invoice").Range.Text & " - " & _
        ActiveDocument.Bookmarks("Name").Range.Text
'    Let 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
        Let .Name = strPath & "\" & strName
        .Show
    End With
    '   Reset save path
    GoTo ResumeProcess
BookMarkMissing:
    MsgBox "It appears that one or more of the bookmarks Name or Invoice is missing."
ResumeProcess:
    Let Application.Options.DefaultFilePath(wdDocumentsPath) = strPath
    '   empty object and reset Error Handler
    Set dlgSave = Nothing
    On Error GoTo -1
End Sub

Sub FileSave()
    FileSaveAs
End Sub