Naming files as Content Control in doc

[Domgau33]

Hi there i am new to this forum and new to VBA as well. I have created a Word for that autofills using data from an excel table through mail merge to create multiple personalized letters all at once. I also found a code for Word VBA seen below that allows me to save each individual page from the resulting document as its own PDF but when it saves it names the files Page 1, Page 2. Etc. I would rather the code grab the file name from the same document as i can set the "rich text" content control to the applicable field that i want the file named as but i am not advanced enough to write the code to save each page as the text in that control field. Any help would be appreciated.

Sub SaveAsSeparatePDFs()
'UpdatebyExtendoffice20181120
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("Start Page", "KuTools for Word"))
xEnd = CInt(InputBox("End Page:", "KuTools for Word"))
If xStart <= xEnd Then
For I = xStart To xEnd
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
xFolder & "\Page_" & 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, "KuTools for Word"
End Sub

[arnelgp]

'run this sub first to get the ID of the Content Control
'take note of the number and substitute it to "xXx" (do not remove the Quoute (")) in SaveAsSeparatePDFs() sub
'note: You only need to get the ID number once.
Private Sub x()
Dim ctl As ContentControl
For Each ctl In ThisDocument.ContentControls
Debug.Print ctl.ID, ctl.Range.Text
Next
End Sub




Sub SaveAsSeparatePDFs()
'UpdatebyExtendoffice20181120
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("Start Page", "KuTools for Word"))
xEnd = CInt(InputBox("End Page:", "KuTools for Word"))
If xStart <= xEnd Then
For I = xStart To xEnd
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
xFolder & ThisDocument.ContentControls("xXx").Range.Text & "_" & 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, "KuTools for Word"
End Sub

[gmayor]

You could instead see https://www.gmayor.com/MergeAndSplit.htm (https://www.gmayor.com/MergeAndSplit.htm) which would do the job for you, either during the merge or subsequently, using merge fields for the data.

[Domgau33]

I had to remove a few items (shown in red below) to have the code work correctly but I am still having issues because the Content Control is linked to a variable field (name taken from an Excel data sheet through Mail Marge). This causes the code to save all the files (30+) under the name of the first Content Control ID. an thoughts?

And thank you GMayor for the suggestion however I am not able to download that Add-In to this device.

Private Sub x()
Dim ctl As ContentControl
For Each ctl In ThisDocument.ContentControls
Debug.Print ctl.ID, ctl.Range.Text
Next
End Sub




Sub SaveAsSeparatePDFs()
'UpdatebyExtendoffice20181120
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("Start Page", "KuTools for Word"))
xEnd = CInt(InputBox("End Page:", "KuTools for Word"))
If xStart <= xEnd Then
For I = xStart To xEnd
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
xFolder & ThisDocument.ContentControls("xXx").Range.Text & "_" & 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, "KuTools for Word"
End Sub

[gmayor]

And thank you GMayor for the suggestion however I am not able to download that Add-In to this device.
You are not allowed to download tools that do the job, written by a professional Word programmer, but you are allowed to dabble with VBA that can cause all kinds of problems in inexperienced hands? That makes a lot of sense. :rolleyes:

[Domgau33]

*****Correction********
Had to add the previous red lines back but am now getting error "enter right page number" even after having selected the folder and enterred the correct start and end page number. Trying to find a way to have the Name in the content control of each page set as the file name.

Private Sub x()
Dim ctl As ContentControl
For Each ctl In ThisDocument.ContentControls
Debug.Print ctl.ID, ctl.Range.Text
Next
End Sub

Sub SaveAsSeparatePDFs()
'UpdatebyExtendoffice20181120
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("Start Page", "KuTools for Word"))
xEnd = CInt(InputBox("End Page:", "KuTools for Word"))
If xStart <= xEnd Then
For I = xStart To xEnd
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
xFolder & ThisDocument.ContentControls("xXx").Range.Text & "_" & 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, "KuTools for Word"
End Sub

[Chas Kenyon]

See Save document based on template in special folder with date or other information pre-loaded (https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_win10-msoversion_other/save-document-based-on-template-in-special-folder/e1a71dbc-4af8-4216-9112-449d013115fd?tm=1596934485817) for some ideas.