Creating New Documents At Each Heading

[Fred Goldman]

I'm trying to create a documents from all the text between each headin. For
example Heading1 after that is BodyText1 and BodyText2, create a single
document from that until the next Heading1 and so on.

Here's what I've got:

Dim myPara As Style
Dim myLastStyle As Style
Dim x As Long
Dim myTemplate As String
x = 1
myTemplate = Templates("C:\Templates\Chatzros Kadshechu.dot")
Set myLastStyle = ActiveDocument.Styles("LastParagraph")
Set myPara = ActiveDocument.Styles("Heading1")
Do
Do
Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
'At the following line it chokes because it selects two
paragraphs
'which have two different styles
Loop While Selection.Style <> myPara
Selection.Copy
Documents.Add Template:=myTemplate
ActiveDocument.Range.PasteAndFormat wdFormatOriginalFormatting
ActiveDocument.SaveAs FileName:="D" & x
ActiveDocument.Close
x = x + 1
Selection.MoveDown Unit:=wdParagraph, Count:=1
Loop Until Selection.Style = myLastStyle
End Sub

 

[Andra]

did you see two replies to your 24jan message?

Fred Goldman wrote

 

[Fred Goldman]

Yeah, thanks for the replies, I tried both of them, and they didn't work
(same problem). I would've posted there, but I thought it was too old and
noone would be following it (you've got a good memory!).

 

[Doug Robbins - Word MVP]

The following will need a bit of customising to suit the exact name of your
Heading 1 style and also to use your template, but it does create a separate
document for each heading 1 in the original document with each new document
containing the heading 1 and the text that follows it before the next
heading 1

Dim myrange As Range, i As Long, newdoc As Document, j As Long
j = 1
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles( _
"Heading 1,Section,Main,h1,Heading1")
With Selection.Find
Do While .Execute(FindText:="", MatchWildcards:=False,
Wrap:=wdFindContinue, Forward:=True) = True
i = 1
Set myrange = Selection.Range
myrange.End = ActiveDocument.Range.End
Selection.Collapse wdCollapseEnd
For i = 2 To myrange.Paragraphs.Count
If myrange.Paragraphs(i).Style = ActiveDocument.Styles( _
"Heading 1,Section,Main,h1,Heading1") Then
Exit For
End If
Next i
myrange.End = myrange.Start + myrange.Paragraphs(i - 1).Range.End
Set newdoc = Documents.Add
newdoc.Range.FormattedText = myrange.FormattedText
newdoc.SaveAs "C:\aqs\newdoc" & j
newdoc.Close
j = j + 1
myrange.Cut
Loop
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Fred Goldman]

I can't figure out why this is happening. I have 62 headings and it is only
making 7 Documents and at random headings, no specific order. Any
suggestions? None of my styles have plus signs etc.

 

[Fred Goldman]

I am desperately trying to read this macro, but I'm too much of a novice to
understand what it says. However, this may help, some of the headings have
only one paragraph of text after them (not exclusively the ones that it's
skipping though), also the whole document is only one section.

 

[Doug Robbins - Word MVP]

Neither of those things should make any difference, nor why you thought to
mention the plus signs. Does each "heading" have the same style applied to
it?

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Fred Goldman]

Yes, and I also tried changing all the headings to Heading 1 and ran the code
without making any changes with the same results.

 

[Fred Goldman]

Ok, now I had a few paragraphs before the first heading (the title, author
etc.). I deleted those and now it goes through the first 18 without a problem
and then it starts skipping again.

 

[Doug Robbins - Word MVP]

Modify the definition of the Style so that it has a pagebreak before it and
then use the following macro:

Sub splitter()

'

' splitter Macro

' Macro created 16-08-98 by Doug Robbins to save each page of a document

' as a separate file with the name Page#.DOC

'

Dim Counter As Long, Source As Document, Target As Document

Set Source = ActiveDocument

Selection.HomeKey Unit:=wdStory

Pages = Source.BuiltInDocumentProperties(wdPropertyPages)

Counter = 0

While Counter < Pages

Counter = Counter + 1

DocName = "Page" & Format(Counter)

Source.Bookmarks("\Page").Range.Cut

Set Target = Documents.Add

Target.Range.Paste

Target.SaveAs FileName:=DocName

Target.Close

Wend

End Sub

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Fred Goldman]

Hah! All taken care of! I had two comments in the document. These must have
thrown the whole code off. Now it works like a charm. Thank you very much for
your help, Doug.

This will most likely be the last time I use comments. What a mess! I never
thought it would actually effect the main story, very interesting.