Word VBA技术求助：拆分多信函文档导出PDF，移除打印功能

一、移除打印功能 #

直接删除这段打印相关的代码即可：

ActiveDocument.PrintOut Background:=False, _
Range:=wdPrintFromTo, _
From:="s" & Format(Counter), To:="s" & Format(Counter)

二、修改PDF导出逻辑（按节导出） #

原来的导出代码默认导出整个文档，需要调整ExportAsFixedFormat的参数，指定只导出当前节：

1. 将Range:=wdExportAllDocument改为Range:=wdExportFromTo
2. 添加From:="s" & Counter和To:="s" & Counter参数，锁定当前循环对应的节
3. 把变量声明移到循环外，避免重复声明浪费资源

修改后的完整代码 #

Sub ExportLettersToPDF() 
Dim path As String
Dim reminder As Integer
Dim oExtension As String
Dim Fso As Object, oFolder As Object, oSubfolder As Object, oFile As Object, queue As Collection
Dim Letters As Long
Dim Counter As Long
Dim extra_text As String
Dim file_name As String
Dim final_text As String
Dim MyDate As String
Dim MyNumber As Integer

On Error Resume Next

path = "C:\Mailmerge"

If optionCancel = "yes" Then
    optionCancel = "No"
    Exit Sub
End If

reminder = MsgBox("Are you sure you want to export these files?", vbYesNo, "WARNING !!")

If reminder = vbYes Then    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    queue.Add Fso.GetFolder(path)

    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1
        
        For Each oSubfolder In oFolder.subfolders
            queue.Add oSubfolder
        Next oSubfolder
        
        For Each oFile In oFolder.Files
            oExtension = LCase(Right(oFile.Name, Len(oFile.Name) - InStrRev(oFile.Name, ".", -1)))

            If oExtension = "docx" Or oExtension = "doc" Or oExtension = "docm" Or oExtension = "rtf" Then
                Documents.Open FileName:=oFile.Path

                Selection.EndKey Unit:=wdStory
                Selection.InsertBreak Type:=wdSectionBreakNextPage
                
                Letters = ActiveDocument.Sections.Count
                Counter = 1
                
                While Counter < Letters
                    MyDate = Format(Date, "YYYYMMDD")
                    MyNumber = Int((99999 - 11111 + 1) * Rnd + 11111)
                    extra_text = "-ALBA"
                    final_text = "A_"
                    file_name = path & "\" & final_text & MyDate & extra_text & MyNumber & ".pdf"

                    ActiveDocument.ExportAsFixedFormat OutputFileName:=file_name, _
                        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
                        wdExportOptimizeForPrint, Range:=wdExportFromTo, From:="s" & Counter, To:="s" & Counter, _
                        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
                        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
                        BitmapMissingFonts:=True, UseISO19005_1:=False
                    
                    Counter = Counter + 1
                Wend

                ActiveDocument.Saved = True
                ActiveDocument.Close
            End If
        Next oFile
    Loop
Else
    MsgBox ("Operation cancelled!!")
End If
End Sub

关键修改说明 #

• 彻底移除所有PrintOut相关代码，取消打印功能
• 调整导出参数实现按节导出，解决了导出整个文档的问题
• 优化扩展名判断逻辑（转小写后判断，减少重复代码）
• 给PDF文件名添加路径，确保文件保存到指定的C:\Mailmerge文件夹
• 调整变量声明位置，避免循环内重复声明
• 把原过程名Print改为ExportLettersToPDF，避免和VBA内置关键字冲突

内容的提问来源于stack exchange，提问作者James Pyman