Открытие и сохранение документа Word в новом месте файла из Excel

Question

Я пытаюсь открыть документ Word из Excel, а затем сохранить в новом месте файла с помощью диалогового окна.

Проблема в том, что он сохраняет файл Excel, а не файл слова, который был открыт.

Option Explicit
Sub SaveWordDoc()
    Dim WordApp As Object, WordDoc As Object, path As String
    Dim dlgSaveAs As FileDialog

    ' Allows word document to be selected and opened
    With Application.FileDialog(msoFileDialogOpen)
    .Show
    If .SelectedItems.Count = 1 Then
        path = .SelectedItems(1)
    End If
    End With

    If path = "" Then
        Exit Sub
    End If


    Set WordApp = CreateObject("Word.Application")
    Set WordDoc = WordApp.Documents.Open(path)
    WordApp.Visible = False

    'Opens Save As dialog box
    Set dlgSaveAs = Application.FileDialog( _
    FileDialogType:=msoFileDialogSaveAs)
    dlgSaveAs.Show

    WordApp.ActiveDocument.Close
    WordApp.Quit
    Set WordApp = Nothing
    Set WordDoc = Nothing
End Sub

Answer 1

Спасибо, BigBen, ваше предложение работает хорошо, пока выбран формат текстового документа.

Option Explicit
Sub Test()
    Dim WordApp As Object, WordDoc As Object, path As String
    Dim dlgSaveAs As FileDialog, fileSaveName As Variant

    ' To get the code to function I had to include the Microsoft Word 16 Object
    'Library.

    'From the excel VBA editor window. Tools > References then ensure Microsoft Word
    '16.0 Object Library is checked.

    ' Allows word document to be selected and opened
    With Application.FileDialog(msoFileDialogOpen)
    .Show
    If .SelectedItems.Count = 1 Then
        path = .SelectedItems(1)
    End If
    End With

    If path = "" Then
        Exit Sub
    End If


    Set WordApp = CreateObject("Word.Application")
    Set WordDoc = WordApp.Documents.Open(path)
    WordApp.Visible = False

    ' Allows word document to be saved under a different file location and name
    fileSaveName = Application.GetSaveAsFilename( _
    fileFilter:="Word Documents (*.docx), *.docx")
    WordApp.ActiveDocument.SaveAs2 Filename:=fileSaveName, _
        FileFormat:=wdFormatDocumentDefault

    WordApp.ActiveDocument.Close
    WordApp.Quit

    Set WordApp = Nothing
    Set WordDoc = Nothing
End Sub