批量处理修订版word小工具

小工具的由来：某个周五下午，小默非常忙，还需要去见客户。就在要去见客户之前，有7个非清洁版的word文件需要修改成清洁版再生成pdf，邮件发送给一个同事，虽然是小事，紧急情况下还是会DT。因为见客户比较重要，我选择见完客户回来再做。周末在家无聊，就想如果这种事情可以一键搞定多好。

工具的作用

• 接受非清洁版中所有修订；
• 删除所有批注；
• 在当前文件夹下生成clean文件夹用以保存新生成的清洁word和pdf文件；

使用方法

初始准备阶段

• 打开word文档；
• 打开VBA编辑器；word打开VBA编辑器的方法
• 将以下代码复制到VBA编辑器中；
• 添加快捷键；添加按钮教程

使用

• 使用方法1 打开需要批量处理文件夹下的一个word，点击上述添加的快捷键；
• 使用方法2 打开需要批量处理文件夹下的一个word，打开宏运行【批量清洁版PDF文件生成工具】'；

Sub 批量清洁版PDF文件生成工具BY陈默()
Dim path, file As String
Dim cmt As Comment
Dim doc As Document
Dim pdfname As String
Dim newdoc As String
Dim NewPath As String
Dim file_first As String
path = ActiveDocument.path & "\"
NewPath = path & "clean" & "\"
Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists(NewPath) = False Then
        MkDir NewPath    '//创建文件夹
    End If


file = Dir(path & "*.doc*")
file_first = file
Do While file <> ""
    ChangeFileOpenDirectory path
    Documents.Open FileName:=file, ConfirmConversions:= _
        False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
        

    For Each cmt In ActiveDocument.Comments
        cmt.Delete
    Next
    
    ActiveDocument.AcceptAllRevisions
    ActiveDocument.TrackRevisions = False
    
    pdfname = Split(file, ".d")(0) & ".pdf"
    newdoc = Split(file, ".d")(0) & "clean" & ".docx"
    
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        NewPath & pdfname, _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
    ChangeFileOpenDirectory NewPath
    
    ChangeFileOpenDirectory NewPath
    ActiveDocument.SaveAs2 FileName:=newdoc, FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, CompatibilityMode:=15
        
    
    ActiveDocument.Close
    file = Dir
    Loop
    ChangeFileOpenDirectory path
    Documents.Open FileName:=file_first, ConfirmConversions:= _
        False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
End Sub