Function wdSaveCopyAs(newFilePath As String, newFileName As String, Optional FFormat As WdSaveFormat) As String
Dim wdOriginalDocXML As String, wdOriginalDocName As String, wdNewDocFile As String, xFileFormat As WdSaveFormat
    Application.ScreenUpdating = False
    wdOriginalDocXML = ActiveDocument.Content.XML
    wdOriginalDocName = ActiveDocument.Name
Dim wdNewDoc As New word.Document
    wdNewDoc.Content.InsertXML wdOriginalDocXML
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'If newFileName = "" Then
'    Dim dlgSaveAs As FileDialog
'        Set dlgSaveAs = Application.FileDialog( _
'        FileDialogType:=msoFileDialogSaveAs)
'        dlgSaveAs.Show
'Else
If FFormat Then
    xFileFormat = FFormat
Else: FFormat = wdFormatXMLDocument
End If
wdNewDocFile = Replace(newFilePath & Application.PathSeparator & newFileName, "\\", "\")
wdNewDoc.SaveAs wdNewDocFile, FileFormat:=FFormat, AddToRecentFiles:=False
wdNewDocFile = wdNewDoc.Path & Application.PathSeparator & wdNewDoc.Name
wdNewDoc.Close
Application.ScreenUpdating = True
wdSaveCopyAs = wdNewDocFile
End Function