VBA操作WORD（六）另存為不含宏的文檔

 

Sub 另存為不含宏的文檔()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Dim oDoc As Document
    Set oDoc = Word.ActiveDocument
    Dim oRng As Range
    Set oRng = oDoc.Content

    Dim sPath As String
    '默認存儲路徑，當前用戶桌面，注釋掉的是當前文檔路徑
    sPath = Environ("userprofile") & "\Desktop\" 'Word.ActiveDocument.Path & "\"

    '處理文件名
    Dim strDocName As String
    strDocName = ActiveDocument.Paragraphs(1).Range.Text '包含一個回車符
    strDocName = Replace(strDocName, Chr(13), "") 'chr(10)'刪除句末回車符，沒有trim空格
    
    '采用復制內容到新文檔的形式，避免將宏代碼帶到新文檔
    oRng.Select
    oRng.Copy
    Dim oDocTemp As Document
    Set oDocTemp = Word.Documents.Add
    With oDocTemp.Application.Selection
        .Paste
    End With
    
    'Dim vrtSelectedItem As Variant
    Dim fDialog As FileDialog
        Set fDialog = Application.FileDialog(msoFileDialogSaveAs)
    With fDialog
        .AllowMultiSelect = False
        .Filters.Clear '不清空會造成多次添加
        .Filters.Add "Word文件", "*.doc;*.docx;*.docm", 1
        .InitialFileName = sPath '& strDocName 'Left(vrtSelectedItem, Len(vrtSelectedItem) - 5)
        '返回值-1表示按下確認按鈕。如果沒有判斷，那么無論點擊哪個按鈕，均會保存文件到磁盤。
        If .Show = -1 Then
            'Set oDocTemp = Application.Documents.Save(vrtSelectedItem, ReadOnly:=True)'vrtSelectedItem為空
            '.Execute'execute是SaveAs對話框配套的保存命令，執行的是直接另存為操作，會把宏代碼帶到新文檔。改為調用SaveAs2方法完成存儲操作
            '.SelectedItems.Item(1)是對話框文件名修改后的名字。SelectedItems(1)為null
            oDocTemp.SaveAs2 filename:=.SelectedItems.Item(1), FileFormat:=wdFormatDocumentDefault
            oDocTemp.Close False
        End If
    End With
    Set fDialog = Nothing

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

上面代碼需要注意地方兩點，也是浪費我很多時間的地方，一是如果采用標題之類作為文件名，因為包括了回車符（換行符）導致代碼一直報錯，需要先刪掉才能保存成功。

第二點，微軟官方文檔SaveAs2例子的人機交互有點不是很友好，直接用InputBox讓用戶輸入文件名（見中間注釋掉的代碼）。所以考慮用dialog彈出另存的對話框，由用戶選擇文件類型和修改文件名（默認默認為文件內容的第一行（標題），減少手工勞動），但又有新的問題，dialog的.execute命令會直接將當前文檔另存為新文檔，導致VBA宏代碼等也跟着到新文檔，徒增文件體積。而我希望不要把宏代碼帶到新文檔，采用聲明一個新的文檔對象，並且把當前文檔的內容復制過去的形式，再使用了SaveAs2方法另存為新生成的文檔對象。

上面的代碼很好的結合了兩方的優點，解決了缺點，完美！上面的處理方法是原創，反正我沒看到過類似的解決方案。

中間注釋掉對文件名處理部分，留給有需要的人參考。

 

    '摘抄自微軟官方文檔的一個例子
    Dim intPos As Integer
    intPos = InStrRev(strDocName, ".")
    '此處刪除后綴名，后續另存為對話框中選擇文件類型后再加上后綴名
    If intPos = 0 Then
        ' 如果文檔還未保存，問用戶輸入文件名
        strDocName = InputBox("請輸入要保存的文件名：")
    Else
        '刪除原來的后綴名並添加新的后綴名
        strDocName = Left(strDocName, intPos - 1)
        strDocName = strDocName & ".docx"
    End If

 

--end--

--2020/4/22最后更新--