Consulting

Results 1 to 7 of 7

Thread: Naming files as Content Control in doc

  1. #1
    VBAX Newbie
    Joined
    Sep 2021
    Posts
    3
    Location

    Naming files as Content Control in doc

    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

  2. #2
    '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
    Last edited by arnelgp; 09-02-2021 at 11:28 PM.

  3. #3
    You could instead see 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.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  4. #4
    VBAX Newbie
    Joined
    Sep 2021
    Posts
    3
    Location
    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

  5. #5
    Quote Originally Posted by Domgau33 View Post
    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.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  6. #6
    VBAX Newbie
    Joined
    Sep 2021
    Posts
    3
    Location
    *****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

  7. #7

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •