<aside> 🔔 ❤️感謝YT粉絲提供(@user-dq3bu7nv8l )

</aside>

#輸出成信件後將每一頁個別輸出成pdf

Sub SaveAsSeparatePDFs()
    Dim I As Long
    Dim xStr As String
    Dim xPathStr As Variant
    Dim xFileDlg As FileDialog
    Dim xStartPage As Long, xEndPage As Long
    Dim xStartPageStr As String, xEndPageStr As String
    Dim firstLine As String
    Dim rng As Range
    Dim docName As String

    ' 設置文件對話框
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    If xFileDlg.Show <> -1 Then
        MsgBox "Please choose a valid directory", vbInformation, "Kutools for Word"
        Exit Sub
    End If
    xPathStr = xFileDlg.SelectedItems(1)

    ' 獲取開始和結束頁面
    xStartPageStr = InputBox("Begin saving PDFs starting with page __? " & vbNewLine & "(ex: 1)", "Kutools for Word")
    xEndPageStr = InputBox("Save PDFs until page __?" & vbNewLine & "(ex: 7)", "Kutools for Word")
    If Not (IsNumeric(xStartPageStr) And IsNumeric(xEndPageStr)) Then
        MsgBox "The entering start page and end page should be number format", vbInformation, "Kutools for Word"
        Exit Sub
    End If
    xStartPage = CInt(xStartPageStr)
    xEndPage = CInt(xEndPageStr)
    If xStartPage > xEndPage Then
        MsgBox "The start page number can't be larger than end page", vbInformation, "Kutools for Word"
        Exit Sub
    End If
    If xEndPage > ActiveDocument.BuiltInDocumentProperties(wdPropertyPages) Then
        xEndPage = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
    End If

    ' 開始逐頁保存
    For I = xStartPage To xEndPage
        ' 移動到頁面的開始
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=I
        Set rng = Selection.Bookmarks("\\page").Range

        ' 獲取第一行文字，注意檔名若重複會覆寫
        rng.Collapse Direction:=wdCollapseStart
        rng.End = rng.Paragraphs(1).Range.End
        firstLine = Trim(rng.Text)

        ' 如果第一行文字為空，使用默認頁碼命名
        If firstLine = "" Then
            firstLine = "Page_" & I
        End If

        ' 移除非法檔案名字符
        docName = Replace(firstLine, "\\", "")
        docName = Replace(docName, "/", "")
        docName = Replace(docName, ":", "")
        docName = Replace(docName, "*", "")
        docName = Replace(docName, "?", "")
        docName = Replace(docName, """", "")
        docName = Replace(docName, "<", "")
        docName = Replace(docName, ">", "")
        docName = Replace(docName, "|", "")
        docName = Replace(docName, "&", "")
        docName = Replace(docName, " ", "_")
        docName = Replace(docName, vbCr, "")
        docName = Replace(docName, vbLf, "")
        docName = Replace(docName, vbCrLf, "")

        ' 儲存為 PDF
        ActiveDocument.ExportAsFixedFormat xPathStr & "\\" & docName & ".pdf", _
        wdExportFormatPDF, False, wdExportOptimizeForPrint, wdExportFromTo, I, I, wdExportDocumentWithMarkup, _
        False, False, wdExportCreateNoBookmarks, True, False, False
    Next I

    MsgBox "PDFs saved successfully!", vbInformation, "Kutools for Word"
End Sub

語法解釋

1. 宣告變數

vba
複製程式碼
Dim I As Long
Dim xStr As String
Dim xPathStr As Variant
Dim xFileDlg As FileDialog
Dim xStartPage As Long, xEndPage As Long
Dim xStartPageStr As String, xEndPageStr As String
Dim firstLine As String
Dim rng As Range
Dim docName As String

功能：

• I: 作為頁碼的計數器，用於迴圈。
• xStr: 預備用於處理文字（此範例未用到）。
• xPathStr: 用於儲存使用者選擇的目錄路徑。
• xFileDlg: 文件對話框對象，讓使用者選擇儲存目錄。
• xStartPage、xEndPage: 開始頁碼與結束頁碼（數字格式）。
• xStartPageStr、xEndPageStr: 開始頁碼與結束頁碼的文字輸入。
• firstLine: 儲存每頁第一行文字，用於生成檔名。
• rng: 範圍對象，用於指定特定頁面的內容。
• docName: 用於生成每個頁面的檔案名稱。

2. 文件夾選擇

vba
複製程式碼
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xFileDlg.Show <> -1 Then
    MsgBox "Please choose a valid directory", vbInformation, "Kutools for Word"
    Exit Sub
End If
xPathStr = xFileDlg.SelectedItems(1)

功能：