Attribute VB_Name = "B07_导出PDF宏_zh"
' ============================================================
' B07_导出PDF宏_zh.bas
' B07_ExportPDFMacro_zh.bas
'
' 配套教程：B7《用 AI + 邮件合并批量生成通知》（中文）
' 用途：把 "邮件合并 → 编辑单个文档" 生成的大文档
'       按 "一封信 = 一个 Section" 切成独立 PDF 文件。
' Use :  Split the merged document into one PDF per record.
'
' 安装方法：在 Word 里按 Alt+F11 打开 VBA 编辑器 →
'          右键左侧 "工程" 窗口 → 导入文件 → 选本 .bas。
' Install: In Word press Alt+F11, right-click the project →
'          Import File, pick this .bas.
' ============================================================

Option Explicit

' 主入口：导出当前活动文档的所有节为独立 PDF
' Main entry: export every section in the active document to its own PDF.
Sub 批量导出PDF_按分节()
    '功能：把"邮件合并→编辑单个文档"生成的大文档，
    '      按分节符切成独立文件，逐封导出为 PDF。
    '前提：邮件合并文档类型须为"信函"——信函类型会在每条记录之间
    '      插入分节符，所以"一条记录 = 一个 Section"的假设可靠。
    '用法：先完成邮件合并并"编辑单个文档"，再运行本宏。

    Dim doc As Document, newDoc As Document
    Dim sec As Section
    Dim i As Long
    Dim outPath As String
    Dim fso As Object

    '★ 改成你自己的导出文件夹；不用提前手动建，宏会自动建（容错）
    '★ Change this to a folder you have write access to.
    outPath = "C:\导出PDF\"

    '★ outPath 容错：文件夹不存在就自动建（需父目录存在，如 C:\ 已存在）
    '★ Create the folder if it does not exist (parent must exist).
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(outPath) Then fso.CreateFolder outPath

    Set doc = ActiveDocument
    i = 0
    Application.ScreenUpdating = False

    '★ 节数自检：先确认"一条记录 = 一个 Section"的假设成立再遍历，
    '   避免静默只导 1 个 PDF。
    '★ Section-count sanity check: avoid silently exporting only 1 PDF.
    If doc.Sections.Count < 2 Then
        MsgBox "检测到本文档只有 " & doc.Sections.Count & " 个节。" & vbCr & _
               "请确认：『开始邮件合并』选的是『信函』类型，" & _
               "并已『完成并合并 → 编辑单个文档』。" & vbCr & _
               "（若你本就只有 1 条记录，1 节是正常的，可继续。）", _
               vbExclamation, "B07 批量导出"
    End If

    ' 逐节复制 → 新文档 → 另存 PDF → 关闭
    ' For each section: copy → new doc → save as PDF → close.
    For Each sec In doc.Sections
        i = i + 1
        sec.Range.Copy                 '复制这一"节"（一封信）
                                      'Copy this section (one letter).
        Set newDoc = Documents.Add     '开个空白新文档
                                      'Create a blank document.
        newDoc.Range.Paste             '粘进新文档（指定目标，比 Selection.Paste 更稳）
                                      'Paste into the new doc directly.

        '导出为 PDF，文件名带序号
        'Export to PDF; file name includes the index.
        newDoc.ExportAsFixedFormat _
            OutputFileName:=outPath & "通知_" & i & ".pdf", _
            ExportFormat:=wdExportFormatPDF

        newDoc.Close SaveChanges:=False
    Next sec

    Application.ScreenUpdating = True
    MsgBox "搞定！共导出 " & i & " 个 PDF 到 " & outPath, _
           vbInformation, "B07 批量导出"
End Sub


' 可选辅助：按"姓名"域作为文件名（更直观，避免 1/2/3 编号难找）
' Optional helper: name each PDF by recipient name (friendlier than 1, 2, 3…).
Sub 批量导出PDF_按姓名命名()
    Dim doc As Document, newDoc As Document
    Dim sec As Section
    Dim i As Long
    Dim outPath As String
    Dim fso As Object
    Dim nameField As String
    Dim safeName As String

    outPath = "C:\导出PDF\"

    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(outPath) Then fso.CreateFolder outPath

    Set doc = ActiveDocument
    i = 0
    Application.ScreenUpdating = False

    If doc.Sections.Count < 2 Then
        MsgBox "请先完成邮件合并并『编辑单个文档』。", vbExclamation
        Exit Sub
    End If

    For Each sec In doc.Sections
        i = i + 1
        sec.Range.Copy
        Set newDoc = Documents.Add
        newDoc.Range.Paste

        ' 从正文中读第一个合并域的内容（姓名域），再做文件名安全过滤
        ' Read the first MERGEFIELD text (Name) and sanitize it for file names.
        On Error Resume Next
        nameField = newDoc.Fields(1).Result.Text   '第 1 个合并域 = 姓名
        On Error GoTo 0

        ' 把换行/制表/非法字符替换为下划线，避免 Windows 文件名报错
        ' Replace newlines / tabs / illegal chars with underscore.
        safeName = Replace(nameField, vbCr, "")
        safeName = Replace(safeName, vbLf, "")
        safeName = Replace(safeName, vbTab, "")
        safeName = Replace(safeName, "\", "_")
        safeName = Replace(safeName, "/", "_")
        safeName = Replace(safeName, ":", "_")
        safeName = Replace(safeName, "*", "_")
        safeName = Replace(safeName, "?", "_")
        safeName = Replace(safeName, """", "_")
        safeName = Replace(safeName, "<", "_")
        safeName = Replace(safeName, ">", "_")
        safeName = Replace(safeName, "|", "_")

        If Len(safeName) = 0 Then safeName = "记录_" & i   '兜底：姓名为空时用序号
                                              'Fallback when name is empty.

        newDoc.ExportAsFixedFormat _
            OutputFileName:=outPath & safeName & ".pdf", _
            ExportFormat:=wdExportFormatPDF

        newDoc.Close SaveChanges:=False
    Next sec

    Application.ScreenUpdating = True
    MsgBox "搞定！共导出 " & i & " 个 PDF 到 " & outPath, _
           vbInformation, "B07 批量导出"
End Sub