Split multi page document to seperate page documents

[buhay]

Does anyone know how to split multi page document with headerandfooters to seperate page documents. I have been trying to split it with this code below but for some reason the splitted documents end up with two pages instead of only one pages.

Sub SplittingDocumentIntoPages()
' Used to set criteria for moving through the document by page.
Application.Browser.Target = wdBrowsePage

For i = 1 To ActiveDocument.BuiltInDocumentProperties("Number of Pages")

'Select and copy the text to the clipboard.
ActiveDocument.Bookmarks("\page").Range.Copy

' Open new document to paste the content of the clipboard into.
Documents.Add
Selection.Paste
' Removes the break that is copied at the end of the page, if any.
Selection.TypeBackspace
ChangeFileOpenDirectory "H:\My Documents\"
DocNum = DocNum + 1
ActiveDocument.SaveAs FileName:="Abrechnung_" & DocNum & ".doc"
ActiveDocument.Close

' Move the selection to the next page in the document.
Application.Browser.Next
Next i

End Sub

Pleas have a look at the attachement and try it out yourself. Even the split procedure posted somewhere else in this forum doesn't work with my documents.

Any help is highly appreciated

[geekgirlau]

If your new document doesn't have the same margins, it won't end up being the same number of pages. You need to capture the margins of the original document, and apply them to the new document.

[fumei]

This is best achieved by making a document object of the source document, and iterating through your new documents also as document objects. That way you can transfer over the margins directlly.

BTW: your source document uses Word poorly. No styles; extra tabs and paragraphs.

Sub SplittingDocumentIntoPages()
Dim SourceDoc As Document
Dim PagesDoc As Document

Set SourceDoc = ActiveDocument
' Used to set criteria for moving through the document by page.
Application.Browser.Target = wdBrowsePage

For i = 1 To SourceDoc.BuiltInDocumentProperties("Number of Pages")

'Select and copy the text to the clipboard.
SoiurceDoc.Bookmarks("\page").Range.Copy

' Open new document to paste the content of the clipboard into.
Set PagesDoc = Documents.Add
Selection.Paste
' Removes the break that is copied at the end of the page, if any.
Selection.TypeBackspace
DocNum = DocNum + 1
PagesDoc.SaveAs FileName:= _
"H:\My Documents\Abrechnung_" & DocNum & ".doc"
PagesDoc.Close
Set PagesDoc = Nothing
' Move the selection to the next page in the document.
Application.Browser.Next
Next i

End Sub Notice I removed the ChangeFileOpenDirectory. Firstly, it is not needed, and secondly it is inefficient to have a change insruction through each and every iteration of i.

[buhay]

This is best achieved by making a document object of the source document, and iterating through your new documents also as document objects. That way you can transfer over the margins directlly.

BTW: your source document uses Word poorly. No styles; extra tabs and paragraphs.

Sub SplittingDocumentIntoPages()
Dim SourceDoc As Document
Dim PagesDoc As Document

Set SourceDoc = ActiveDocument
' Used to set criteria for moving through the document by page.
Application.Browser.Target = wdBrowsePage

For i = 1 To SourceDoc.BuiltInDocumentProperties("Number of Pages")

'Select and copy the text to the clipboard.
SoiurceDoc.Bookmarks("\page").Range.Copy

' Open new document to paste the content of the clipboard into.
Set PagesDoc = Documents.Add
Selection.Paste
' Removes the break that is copied at the end of the page, if any.
Selection.TypeBackspace
DocNum = DocNum + 1
PagesDoc.SaveAs FileName:= _
"H:\My Documents\Abrechnung_" & DocNum & ".doc"
PagesDoc.Close
Set PagesDoc = Nothing
' Move the selection to the next page in the document.
Application.Browser.Next
Next i

End Sub Notice I removed the ChangeFileOpenDirectory. Firstly, it is not needed, and secondly it is inefficient to have a change insruction through each and every iteration of i.

Using SoiurceDoc.Bookmarks("\page").Range.Copy gives me an error message. I've changed it "to SourceDoc.Bookmarks("\page").Range.Copy" but it doesn't seemt to work.

The splitted documents ended up with two pages(the 2nd page contains the header and I can't deleted it for some reason) instead of one.

[buhay]

After trying out for a while, I came up with the following solution: Copy one page of the orginial multipage document including heading and footers and paste it to a new document. Save the new document under a new name, in this case "C:\SplitTemplate.DOC". I've replace "Set PagesDoc = Documents.Add" with "Documents.Open FileName:="C:\SplitTemplate.DOC" and now it works:)

Use the following code
Sub SplittingDocumentIntoPages()
Dim SourceDoc As Document
Dim PagesDoc As Document

Set SourceDoc = ActiveDocument
' Used to set criteria for moving through the document by page.
Application.Browser.Target = wdBrowsePage

For i = 1 To SourceDoc.BuiltInDocumentProperties("Number of Pages")

'Select and copy the text to the clipboard.
ActiveDocument.Bookmarks("\page").Range.Copy

' Open the SplitTemplate.DOC
Documents.Open FileName:="C:\SplitTemplate.DOC"
Selection.WholeStory
Selection.PasteAndFormat (wdPasteDefault)
' Removes the break that is copied at the end of the page, if any.
Selection.TypeBackspace
DocNum = DocNum + 1
ActiveDocument.SaveAs FileName:="C:\Abrechnung\Abrechnung_" & DocNum & ".doc"
ActiveDocument.Close
Set PagesDoc = Nothing
' Move the selection to the next page in the document.
Application.Browser.Next
Next i

End Sub

fumei and geekgirlau, thank you so much for helping me out. I really appreciate this

[Zack Barresse]

melgibson2, please stop editing your posts to contain a single letter. I do not want you deleting posts like that. If you really need things deleted, ask a moderator. Thanks.

[fumei]

Huh? Who is melgibson2???

Hi Zack.

[Zack Barresse]

Hi Gerry!! :)

A user who has been deleting their post (data) for unknown reasons. I'm assuming because they can't delete their posts entirely? I wasn't trying to hijack your thread though!

[fumei]

No problem. Seems they did a good job of deleting, as I had no idea what the heck you were "talking" about.