I have a Merged-letters Document I need to split it into individual letters.
Following code is doing exactly But it didn't copy the header and footer of each individual page. How can I make it to copy headers and footers along with first section.
Right now it is using oDoc.Sections.First.Range.Cut
line to copy the section.
Code:
Sub Splitter_Updated()
' Based on a Macro created 16-08-98 by Doug Robbins to save each letter created by a
' mailmerge as a separate file.
Dim Letters As Long
Dim Counter As Long
Dim Mask As String
Dim DocName As String
Dim oDoc As Document
Dim oNewDoc As Document
Set oDoc = ActiveDocument
oDoc.Save
Selection.EndKey Unit:=wdStory
Letters = Selection.Information(wdActiveEndSectionNumber)
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
DocName = Format(Date, "ddMMyy") _
& "-" & LTrim$(Str$(Counter)) & ".docx"
Debug.Print oDoc.Sections.Count
Debug.Print oDoc.Sections.First.Headers(wdHeaderFooterFirstPage).Range.Text
oDoc.Sections.First.Range.Cut
Set oNewDoc = Documents.Add
'Documents are based on the Normal template
'To use an alternative template follow the link.
With Selection
.Paste
.EndKey Unit:=wdStory
.MoveLeft Unit:=wdCharacter, Count:=1
.Delete Unit:=wdCharacter, Count:=1
End With
oNewDoc.SaveAs FileName:=oDoc.Path & Application.PathSeparator & DocName, AddToRecentFiles:=False
'FileFormat:=wdFormatDocument,
ActiveWindow.Close
Counter = Counter + 1
Wend
oDoc.Close wdDoNotSaveChanges
End Sub