我正在尝试从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
答案 0 :(得分:0)
感谢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