Saving Merged letter as Separate Docs

[Lance]

I don't know much about VBA and the language, so I'm wondering if anyon
can help me. I searched the net for a script to separate a large fil
(134 pages) into individual documents (one page per doc), and I onl
found one script that looked like it might do it (which I'm not sure i
does). I run it, and it gives me an error saying "selection does no
consist of heading levels" I have no clue what is going wrong, any hel
would be great! I'm running office XP.

Sub SaveRecsAsFiles()
' Convert all sections to Subdocs
AllSectionsToSubDoc ActiveDocument
'Save each Subdoc as a separate file
SaveAllSubDocs ActiveDocument
End Sub

Sub AllSectionsToSubDoc(ByRef doc As Word.Document)
Dim secCounter As Long
Dim NrSecs As Long
NrSecs = doc.Sections.Count
'Start from the end because creating
'Subdocs inserts additional sections
For secCounter = NrSecs - 1 To 1 Step -1
doc.Subdocuments.AddFromRange _
doc.Sections(secCounter).Range
Next secCounter
End Sub

Sub SaveAllSubDocs(ByRef doc As Word.Document)
Dim subdoc As Word.Subdocument
Dim newdoc As Word.Document
Dim docCounter As Long
docCounter = 1
'Must be in MasterView to work with
'Subdocs as separate files
doc.ActiveWindow.View = wdMasterView
For Each subdoc In doc.Subdocuments
Set newdoc = subdoc.Open
'Remove NextPage section breaks
'originating from mailmerge
RemoveAllSectionBreaks newdoc
With newdoc
.SaveAs FileName:="MergeResult" & CStr(docCounter)
.Close
End With
docCounter = docCounter + 1
Next subdoc
End Sub

Sub RemoveAllSectionBreaks(doc As Word.Document)
With doc.Range.Find
.ClearFormatting
.Text = "^b"
With .Replacement
.ClearFormatting
.Text = ""
End With
.Execute replace:=wdReplaceAll
End With
End Su

 

[Lance]

Never mind, I found something that works:

Sub Splitter()
' splitter Macro
' Macro created 16-08-98 by Doug Robbins to save each letter created b
a
' mailmerge as a separate file.
' With minor modifications by Graham Mayor 10-02-03

Dim mask As String
Selection.EndKey Unit:=wdStory
Letters = Selection.Information(wdActiveEndSectionNumber)
mask = "mmDDyy"

Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
DocName = "C:\My Documents\Temp\\" & Format(Date, mask) & " "
LTrim$(Str$(Counter))
ActiveDocument.Sections.First.Range.Cut
Documents.Add
Selection.Paste
ActiveDocument.SaveAs FileName:=DocName, FileFormat:=wdFormatDocument
ActiveWindow.Close
Counter = Counter + 1
Wend

End Su