1) Merging to Individual Files
2) Merging to Individual Word Files, but single files will have names taken from datasource
3) Merging to Individual PDF Files, but single files will have names taken from datasource as well
1) Merging to Individual Files (must be merged to new document)
link to the author: Allen Wyatt
Sub BreakOnSection()
Application.Browser.Target = wdBrowseSection
For i = 0 To ((ActiveDocument.Sections.Count) - 1)
On Error GoTo finish:
ActiveDocument.Bookmarks("\Section").Range.Copy
Documents.Add
Selection.Paste
ChangeFileOpenDirectory "C:\YourFolder\"
DocNum = DocNum + 1
ActiveDocument.SaveAs FileName:="test_" & DocNum & ".doc"
ActiveDocument.Close
Application.Browser.Next
Next i
finish:
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub
2) Merging to Individual Word Files, but single files will have names taken from datasource
link to the author: Spanky Raymond and Other co-authors: Mr. Raduner & Remou
Sub SaveIndividualWordFiles()
Dim iRec As Integer
Dim docMail As Document
Dim docLetters As Document
Dim savePath As String
Set docMail = ActiveDocument
savePath = ActiveDocument.Path & amp & "\"
docMail.MailMerge.DataSource.ActiveRecord = wdLastRecord
iRec = docMail.MailMerge.DataSource.ActiveRecord
docMail.MailMerge.DataSource.ActiveRecord = wdFirstRecord
For i = 1 To iRec
With docMail.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
sFName = .DataFields("NameOfYourColumn").Value 'give name of your field from data souece, this name will be used to name file
End With
.Execute Pause:=False
Set docLetters = ActiveDocument
End With
docLetters.SaveAs FileName:=savePath & amp & sFName
docLetters.Close False
docMail.MailMerge.DataSource.ActiveRecord = wdNextRecord
Next
End Sub
3) Merging to Individual PDF Files, but single files will have names taken from datasource as well
link to the author: Spanky Raymond and Other co-authors: Mr. Raduner & Remou
Sub SavePdfIndividualFiles()
Dim iRec As Integer
Dim docMail As Document
Dim docLetters As Document
Dim savePath As String
Set docMail = ActiveDocument
savePath = ActiveDocument.Path & amp & "\"
docMail.MailMerge.DataSource.ActiveRecord = wdLastRecord
iRec = docMail.MailMerge.DataSource.ActiveRecord
docMail.MailMerge.DataSource.ActiveRecord = wdFirstRecord
For i = 1 To iRec
With docMail.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
sFName = .DataFields("NameOfYourColumn").Value 'give name of your field from data souece, this name will be used to name file
End With
.Execute Pause:=False
Set docLetters = ActiveDocument
End With
docLetters.ExportAsFixedFormat OutputFileName:= _
savePath & amp & sFName & amp & ".pdf", ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
docLetters.Close False
docMail.MailMerge.DataSource.ActiveRecord = wdNextRecord
Next
End Sub
MERGEFIELDS
Sub test()
Dim oPara As Paragraph
For Each oPara In ActiveDocument.Paragraphs
If Len(oPara.Range.Text) = 1 Then
oPara.Range.Delete
End If
Next
Dim strFirstWord As String
Dim strLastWord As String
Dim objDoc As Document
Dim objWord As Object
Set objDoc = ActiveDocument
strFirstWord = "Procent odp." 'InputBox("Enter the first word:", "First Word")
strLastWord = "Pytanie nr" 'InputBox("Enter the last word:", "Last Word")
With Selection
.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strFirstWord & "*" & strLastWord
.Replacement.Text = strLastWord 'strFirstWord & strLastWord
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End With
Set objDoc = Nothing
Set objWord = Nothing
End Sub
IF Mergefield
Surpress BlankLInes
