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

下面这段代码能用，不过是个半成品。需要时间修改，存在问题如下：

一是中间对文件名处理部分，有点冗余，保留是为了以后手工输入文件名做准备（如果采用弹出dialog另存的方式，就不需要这段代码了）；

二是存储的路径不能设置，实际路径参数无效，只是获取到当前文件的路径。

三是弹出dialog，即使点击取消按钮，实际上文件是存储到磁盘了。

另外需要注意地方两点，也是浪费我很多时间的地方，一是如果采用标题之类作为文件名，因为包括了回车符（换行符）导致代码一直报错，需要

先删掉才能保存成功。二是要用声明一个新的文档对象，并且把当前文档的内容复制过去的形式，再另存新生成的文档对象，而不要简单的把当前

文档另存为新文件名，因为后者会导致VBA宏代码等也跟着到新文档，徒增文件体积。

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