Copy Header and footer along with Section text using VBA

431 views Asked by At

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
0

There are 0 answers