Save the Word file with Specific Text in the Word document

Question

I am new to VBA and tried to work on a code that can save multiple pages of word documents as a separate PDF.

I am not only struggling with the File name, currently, it is saving with Page no but I require it to be a specific field from a Word document.

I have added the screenshot of my word doc and the name of the file should be "User ID" and "Reminder 1 ( this is fixed value)".doc

enter image description here

This is my code

Sub SaveAsSeparatePDFs()
    Dim I As Long
    Dim xDlg As FileDialog
    Dim xFolder As Variant
    Dim xStart, xEnd As Integer
    On Error GoTo lbl
    Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
    If xDlg.Show <> -1 Then Exit Sub
    xFolder = xDlg.SelectedItems(1)
    xStart = CInt(InputBox("Select Start Page No", "Information"))
    xEnd = CInt(InputBox("Select End Page No", "Information"))
    If xStart <= xEnd Then
        For I = xStart To xEnd
            ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                xFolder & "\Reminder 1" & I & ".pdf", ExportFormat:=wdExportFormatPDF, _
                OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
                wdExportFromTo, From:=I, To:=I, Item:=wdExportDocumentContent, _
                IncludeDocProps:=False, KeepIRM:=False, CreateBookmarks:= _
                wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
                BitmapMissingFonts:=False, UseISO19005_1:=False
        Next
    End If
    Exit Sub
lbl:
    MsgBox "Enter right page number", vbInformation, "ERROR"
End Sub

macropod macropod · Accepted Answer · 2021-04-29T20:52:11

It's impossible to know for sure from your screenshot which paragraph your ID# is in. It appears to be in the 3rd paragraph, in which case:

Sub SaveAsSeparatePDFs()
    Dim I As Long, Rng As Range
    Dim xDlg As FileDialog, xFolder As Variant
    Dim xStart As Long, xEnd As Long
    Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
    If xDlg.Show <> -1 Then Exit Sub
    xFolder = xDlg.SelectedItems(1)
    On Error GoTo lbl
    xStart = CInt(InputBox("Select Start Page No", "Information"))
    xEnd = CInt(InputBox("Select End Page No", "Information"))
    If xStart <= xEnd Then
        For I = xStart To xEnd
            With ActiveDocument
                Set Rng = .Range.GoTo(What:=wdGoToPage, Name:=I)
                Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
                .ExportAsFixedFormat OutputFileName:=xFolder & "\" & _
                    Split(Split(Rng.Paragraphs(3).Range.Text, vbCr)(0), ": ")(1) & _
                    " Reminder 1.pdf", ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _
                    OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportFromTo, _
                    From:=I, To:=I, Item:=wdExportDocumentContent, IncludeDocProps:=False, _
                    KeepIRM:=False, CreateBookmarks:=wdExportCreateHeadingBookmarks, _
                    DocStructureTags:=True, BitmapMissingFonts:=False, UseISO19005_1:=False
            End With
        Next
    End If
    Exit Sub
lbl:
    MsgBox "Enter right page number", vbInformation, "ERROR"
End Sub

If it's not the 3rd paragraph, change the '3' in '.Paragraphs(3)' to suit.

Save the Word file with Specific Text in the Word document

1 Answers