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/Forums/office/en-US/18059b97-bf1a-4abb-87b0-65786d9c8365/save-file-as-pdf-by-file-name-using-content-from-current-document-with-word-vba
Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#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.