MS Word- creat new file with every hard page break

Take a look at the following link for an explanation as to how this could be done - http://homepage.swissonline.ch/cindymeister/mergfaq2.htm#SepFile

Hey irudyk,

Its still not working correctly. I'll attach the first two records of the merge so you can see what I'm trying to do. Its a merge from Access to word. I would use the macro that you did for me earlier but these merges are different numbers of pages. (btw thanks again for the other help, the macro works great!) So at the end of the record merge i need to split and create a new file for each one.
mergesplit.doc

Luckily it is actually a Next Page Section Break, and there is a Sections Collection, so a macro to do the job is fairly simple.

Sub SplitMergeResult()
    Dim sec As Section
    Dim rng As Range
    Dim strName As String
    Dim DocA As Document
    Dim DocB As Document
    
    Set DocA = ActiveDocument
    For Each sec In DocA.Sections
        Set rng = sec.Range
        If rng.End < DocA.Range.End Then
            rng.MoveEnd wdCharacter, -1
        End If
        strName = "MyDoc" & Format$(sec.Index, "000") & ".doc"
        Set DocB = Documents.Add
        DocB.SaveAs strName
        DocB.Close
    Next sec
End Sub

Select allOpen in new window

Your document is not the unedited result of a simple Word mailmerge (no section breaks), so my macro wouldn't work. However it also has the copy and paste missing. This is the correction.

Sub SplitMergeResult()
    Dim sec As Section
    Dim rng As Range
    Dim strName As String
    Dim DocA As Document
    Dim DocB As Document
    
    Set DocA = ActiveDocument
    For Each sec In DocA.Sections
        Set rng = sec.Range
        If rng.End < DocA.Range.End Then
            rng.MoveEnd wdCharacter, -1
        End If
        strName = "MyDoc" & Format$(sec.Index, "000") & ".doc"
        rng.Copy
        Set DocB = Documents.Add
        DocB.Range.Paste
        DocB.SaveAs strName
        DocB.Close
    Next sec
End Sub

Select allOpen in new window

Hey GrahamSkan,

I ran the macro and it just copied the whole document over to MyDoc001.doc

Ok I'll try the newest revision and let you know what happens! Thanks!

Hey GrahamSkan,

That last macro worked great! Thanks!!!

Hi GrahamSkan,
                             I am using your Macro above for a RTF document formatted in Landscape.  I run the macro but the new files are created as RTF but as portrait and each file needs to be adjusted to landscape and resetting margins to sell all information.   Can you help?

thks
Ken

Hey kdr2003,

I added this line to make it landscape

DocB.PageSetup.Orientation = wdOrientLandscape


put it inbetween
20:     DocB.Range.Paste
21:     DocB.SaveAs strName

Sub SplitMergeResult()
    Dim i As Integer
    Dim rng As Range
    Dim strName As String
    Dim DocA As Document
    Dim DocB As Document
    Dim rngStart As Long
    Set DocA = ActiveDocument
    Set rng = DocA.Range
    With rng.Find
        .Text = "^m"
        i = 1
        rngStart = 0
       Do While .Execute
            rng.MoveEnd wdCharacter, -1
            rng.Start = rngStart
            rng.Copy
            Set DocB = Documents.Add
            strName = "MyDoc" & Format$(i, "000") & ".doc"
            DocB.Range.Paste
            DocB.PageSetup.Orientation = wdOrientLandscape
            DocB.SaveAs strName
            DocB.Close
            rng.Collapse wdCollapseEnd
            rng.Move wdCharacter, 1
            rngStart = rng.Start
            rng.End = DocA.Range.End
            i = i + 1
        Loop
        'last page
        rng.Copy
        Set DocB = Documents.Add
        strName = "MyDoc" & Format$(i, "000") & ".doc"
        DocB.Range.Paste
        DocB.SaveAs strName
        DocB.Close
    End With
End Sub

Select allOpen in new window

Thanks for info.  

Actually,  I got an error when I ran the macro at the new line.

What is the error message?

It might be a bit better to set the orientation before the paste.