Save file as PDF by file name using content from current document with Word VBA

[tendosai]

Greeting everyone,


So i am trying to make macro to save from word document (many pages) to separate PDF file. However, I want the second line of paragraph as my file name accordingly. Here is my code that i have tried but instead it saving with replace of each other due to same file name.

Sub AllSectionsToSubDoc()
     
    Dim x               As Long
    Dim Sections        As Long
    Dim Doc             As Document
    Dim FirstPara As String
    Dim r As Range
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
     
    
    Set Doc = ActiveDocument
    Sections = Doc.Sections.Count
    For x = Sections - 1 To 1 Step -1
    FirstPara = Paragraphs(2).Range.Text
    FirstPara = Left(FirstPara, Len(FirstPara) - 1)
        Doc.Sections(x).Range.Copy
        Documents.Add
        ActiveDocument.Range.Paste
        ActiveDocument.SaveAs (Doc.Path & "\" & FirstPara & ".pdf"), (wdExportFormatPDF)
        ActiveDocument.Close False
    Next x
     
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
     
End Sub

Another question: I try to trim the paragraph. example: I have my second paragraph "Dear Mr. John Adam". I want my file name "John Adam.pdf" however in my code it gave me full "Dear Mr. John Adam.pdf" instead. I tried using Right(FirstPara, Len(FirstPara) - 1) but i got error command.

[macropod]

It appears you're trying to split the output from a mailmerge. For that, see: Split Merged Output to Separate Documents in the Mailmerge Tips and Tricks thread at: msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html. Better still would be to split the content as the mailmerge is done. For that, see Send Mailmerge Output to Individual Files on the same page.

FWIW, your own code would likely work as:

Sub AllSectionsToSubDoc()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim DocSrc          As Document
    Dim DocTgt          As Document
    Dim s               As Long
    Dim StrNm           As String
    
    Set DocSrc = ActiveDocument
    With DocSrc
        For s = .Sections.Count - 1 To 1 Step -1
            Set DocTgt = Documents.Add
            With .Sections(s).Range
                StrNm = Split(Split(.Paragraphs(2).Range.Text, vbCr)(0), ".")(1)
                DocTgt.Range.FormattedText = .Sections(x).Range.FormattedText
                DocTgt.SaveAs Doc.Path & "\" & StrNm & ".pdf", wdFormatPDF
                DocTgt.Close False
            End With
        Next
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

[gmayor]

You need to process 'firstname' to get the string you want e.g.

Dim vPara as Variant
Dim sName as String
Dim y as Long



FirstPara = Left(FirstPara, Len(FirstPara) - 1)
        vPara = Split(FirstPara, Chr(32))
        sName = ""
        For y = 1 To UBound(vPara)
            sName = sName & vPara(y)
            If y < UBound(vPara) Then sName = sName & Chr(32)
        Next y

Then use sName in the naming code.

I have not seen your original document, but shouldn't the code extract the second para from each section? e.g.

FirstPara = Doc.Sections(x).Range.Paragraphs(2).Range.Text

[macropod]

Cross-posted at: https://social.msdn.microsoft.com/Fo...-with-word-vba
Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq...._new_faq_item3

[tendosai]

gmayor
Thank brother. I tried as you mention.
i got error "The request member of the collection does not exist."

macropod
i paste the code and i got same error "The request member of the collection does not exist."
I actually tried with mail merge trick. i got the pdf save seperately but cant figured out the name. i cant seem to get an idea how to get (let's say "Name" to use as filename when save.

For cross post. i have deleted the post at forum but it still there tho. let me delete again.

[macropod]

macropod
i paste the code and i got same error "The request member of the collection does not exist."

That suggests your source document is not consistently as described; we can only work with what we're given.


Without actually seeing the problem document, with some representative samples of the data, it can be difficult for anyone to diagnose the issue. Can you attach a document to a post with some representative data (delete anything sensitive)? You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.

I actually tried with mail merge trick. i got the pdf save seperately but cant figured out the name. i cant seem to get an idea how to get (let's say "Name" to use as filename when save.

The instructions in the link say quite clearly how to do that...

[tendosai]

Sub Merge_To_Individual_Files()
' Sourced from: https://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html
Application.ScreenUpdating = False
Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long, j As Long
Const StrNoChr As String = """*./\:?|"
Set MainDoc = ActiveDocument
With MainDoc
  StrFolder = .Path & "\"
  With .MailMerge
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True
    On Error Resume Next
    For i = 1 To .DataSource.RecordCount
      With .DataSource
        .FirstRecord = i
        .LastRecord = i
        .ActiveRecord = i
        If Trim(.DataFields("First_Name")) = "" Then Exit For
        'StrFolder = .DataFields("Folder") & "\"
        StrName = .DataFields("First_Name")
      End With
      .Execute Pause:=False
      If Err.Number = 5631 Then
        Err.Clear
        GoTo NextRecord
      End If
      
      With ActiveDocument
        'Add the name to the footer
        '.Sections(1).Footers(wdHeaderFooterPrimary).Range.InsertBefore StrName
       ' .SaveAs FileName:=StrFolder & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
        ' and/or:
        .SaveAs FileName:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
        .Close SaveChanges:=False
      End With
NextRecord:
    Next i
  End With
End With
Application.ScreenUpdating = True
End Sub

Thank bro macropod for pointing the right direction.
If you happen to google and land here. Code above save your .docm (macro enable) file that is using mail merge into .pdf seperately. (it saved the separated file the same path of your .docm file.) I have removed "Last_Name" because i have only "First_Name" I also remove

For j = 1 To Len(StrNoChr)
  StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
Next
StrName = Trim(StrName)

All credit give to Mr. Macropod

[macropod]

I also remove

For j = 1 To Len(StrNoChr)
  StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
Next
StrName = Trim(StrName)

That code exists to remove any characters that would be illegal in a filename; omit it at your peril.