VBA操作WORD（六）另存为不含宏的文档

Sub 另存为不含宏的文档()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    ‘Dim vrtSelectedItem As Variant
    Dim oDoc As Document
    Set oDoc = Word.ActiveDocument
    Dim oRng As Range
    Set oRng = oDoc.Content
    
    Dim sPath As String
    sPath = Word.ActiveDocument.Path & "\"

    ‘处理文件名
    Dim strDocName As String
    Dim intPos As Integer
    strDocName = ActiveDocument.Paragraphs(1).Range.Text ‘包含一个回车符
    Call 替换指定范围关键字(strDocName, Chr(13), "") ‘chr(10)
    intPos = InStrRev(strDocName, ".")

    ‘此处删除后缀名，后续另存为对话框中选择文件类型后再加上后缀名
    If intPos = 0 Then
        ‘ 如果文档还未保存，问用户输入文件名
        ‘strDocName = InputBox("请输入要保存的文件名：")
    Else
        ‘ Strip off extension and add ".txt" 后缀名
        strDocName = Left(strDocName, intPos - 1)
        ‘strDocName = strDocName & ".docx"
    End If
    
    ‘采用复制内容到新文档的形式，避免将宏代码带到新文档
    oRng.Select
    oRng.Copy
    Dim oDocTemp As Document
    Set oDocTemp = Word.Documents.Add
    With oDocTemp.Application.Selection
        .Paste
    End With

    Dim fDialog As FileDialog
        Set fDialog = Application.FileDialog(msoFileDialogSaveAs) ‘返回一个 FileDialog 对象，该对象代表文件对话框的单个实例。
    With fDialog
        .Filters.Clear ‘不清空会造成多次添加
        .Filters.Add "Word文件", "*.doc;*.docx;*.docm", 1
        .InitialFileName = strDocName & vrtSelectedItem ‘"C:\Documents and Settings\Administrator\桌面\" +‘Left(vrtSelectedItem, Len(vrtSelectedItem) - 5)
            .Show
            ‘Set oDocTemp = Application.Documents.Save(vrtSelectedItem, ReadOnly:=True)
            ‘TODO:实际取消对话框也保存到磁盘了。
            oDocTemp.SaveAs2 filename:=.InitialFileName, FileFormat:=wdFormatDocumentDefault
            oDocTemp.Close False
            ‘.Execute‘这个命令执行的是直接另存为操作，会把宏代码带到新文档
    End With
    Set fDialog = Nothing

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub