VBA сохранить файл как заранее определенное имя

Question

Я пытаюсь предварительно заполнить имя файла в диалоге сохранения в Word, используя VBA. Код, который я использую сейчас ThisDocument:

Private Sub Document_New()
  Register_Event_Handler
End Sub

Модуль mdiEventConnect:

Dim X As New EventClassModule
Sub Register_Event_Handler()
  Set X.App = Word.Application
End Sub

Класс EventClassModule:

Public WithEvents App As Word.Application

Private Sub App_DocumentBeforeSave _
  (ByVal Doc As Document, _
  SaveAsUI As Boolean, _
  Cancel As Boolean)

  Dim intResponse As Integer

    intResponse = MsgBox("Do you really want to " _
    & "save the document?", _
    vbYesNo)

 If intResponse = vbNo Then
   Cancel = True
 Else:
   Dim fPth As Object
   Set fPth = Application.FileDialog(msoFileDialogSaveAs)

   With fPth
     .InitialFileName = "Testfile" & ".docx"
     .Title = "Bestand Opslaan"
     .InitialView = msoFileDialogViewList
     .Show
   End With
 End If

End Sub

Проблема, с которой я сталкиваюсь сейчас, заключается в том, что диалоговое окно сохранения появляется как надо, но как только я сохраняю файл, появляется другое диалоговое окно сохранения без заранее заданного имени файла.

Если у кого-нибудь есть какие-либо советы для меня, это будет очень признательно.