zcty
01-26-2018, 07:50 AM
I run the following macro to separate the mailmerged document into individual documents, the file names are as x iteration. So 1,2,3..
I would like however to replace the filename and extract the header of the active file so each new file would have its individual header used as a file name. Ive tried replacing x as you may see below, to no avail. any ideas?
I use the following code to separate from mail merged doc to individual docs. Works like a charm:
Option Explicit
Sub AllSectionsToSubDoc()
Dim x As Long
Dim Sections As Long
Dim Doc As Document
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Doc = ActiveDocument
Sections = Doc.Sections.Count
For x = Sections - 1 To 1 Step -1
Doc.Sections(x).Range.Copy
Documents.Add
ActiveDocument.Range.Paste
ActiveDocument.SaveAs (Doc.Path & "\" & x & ".doc")
ActiveDocument.Close False
Next x
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
The next code is what Ive tried to extract the header;
(basically the abive, replacing x in the save as line.)
Option Explicit
Sub AllSectionsToSubDoc()
Dim x As Long
Dim Sections As Long
Dim Doc As Document
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Doc = ActiveDocument
Sections = Doc.Sections.Count
For x = Sections - 1 To 1 Step -1
Doc.Sections(x).Range.Copy
Documents.Add
ActiveDocument.Range.Paste
ActiveDocument.SaveAs (Doc.Path & "\" & ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader & ".doc")
ActiveDocument.Close False
Next x
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
This didnt work -> syntax error in line 18, any ideas?
Thanks in advance!:cool:
I would like however to replace the filename and extract the header of the active file so each new file would have its individual header used as a file name. Ive tried replacing x as you may see below, to no avail. any ideas?
I use the following code to separate from mail merged doc to individual docs. Works like a charm:
Option Explicit
Sub AllSectionsToSubDoc()
Dim x As Long
Dim Sections As Long
Dim Doc As Document
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Doc = ActiveDocument
Sections = Doc.Sections.Count
For x = Sections - 1 To 1 Step -1
Doc.Sections(x).Range.Copy
Documents.Add
ActiveDocument.Range.Paste
ActiveDocument.SaveAs (Doc.Path & "\" & x & ".doc")
ActiveDocument.Close False
Next x
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
The next code is what Ive tried to extract the header;
(basically the abive, replacing x in the save as line.)
Option Explicit
Sub AllSectionsToSubDoc()
Dim x As Long
Dim Sections As Long
Dim Doc As Document
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Doc = ActiveDocument
Sections = Doc.Sections.Count
For x = Sections - 1 To 1 Step -1
Doc.Sections(x).Range.Copy
Documents.Add
ActiveDocument.Range.Paste
ActiveDocument.SaveAs (Doc.Path & "\" & ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader & ".doc")
ActiveDocument.Close False
Next x
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
This didnt work -> syntax error in line 18, any ideas?
Thanks in advance!:cool: