從Excel打開Word文檔並將其保存到新文件位置

Question

我正在嘗試從excel打開word文檔，然后使用對話框將其另存為新文件位置。

問題在於它保存的是excel文件，而不是已打開的Word文件。

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，只要選擇了Word文檔格式，您的建議就可以很好地發揮作用。

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