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