Missing Headers in New Docs

[mtupstairs]

I am trying to take a multiple page document and turn each page in separate documents. I found this code in the KB on this site and it almost works perfectly for what I need. The problem I am having is that each of my pages has a header and the code is only picking up the header on the last page. I am very, very new to VBA and I cannot figure out how to get the header to copy into each of my documents. Can anyone tell me what to change so I get the header in every document? (Sorry for the way the code is appearing, I do not seem to be able to get the code tags to work properly. I also tried posting a link to the original KB article, but it seems I am too new to post links. Sorry )

Option Explicit 'This goes in the Declarations section of your code module. 'Hopefully it is already there because you have ticked the 'Require Variable Declaration' _ checkbox. (Tools/Options, Editor tab.) Sub SplitIntoPages() Dim docMultiple As Document Dim docSingle As Document Dim rngPage As Range Dim iCurrentPage As Integer Dim iPageCount As Integer Dim strNewFileName As String Application.ScreenUpdating = False 'Makes the code run faster and reduces screen _ flicker a bit. Set docMultiple = ActiveDocument 'Work on the active document _ (the one currently containing the Selection) Set rngPage = docMultiple.Range 'instantiate the range object iCurrentPage = 1 'get the document's page count iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages) Do Until iCurrentPage > iPageCount If iCurrentPage = iPageCount Then rngPage.End = ActiveDocument.Range.End 'last page (there won't be a next page) Else 'Find the beginning of the next page 'Must use the Selection object. The Range.Goto method will not work on a page Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1 'Set the end of the range to the point between the pages rngPage.End = Selection.Start End If rngPage.Copy 'copy the page into the Windows clipboard Set docSingle = Documents.Add 'create a new document docSingle.Range.Paste 'paste the clipboard contents to the new document 'remove any manual page break to prevent a second blank docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:="" 'build a new sequentially-numbered file name based on the original multi-paged file name and path strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc") docSingle.SaveAs strNewFileName 'save the new single-paged document iCurrentPage = iCurrentPage + 1 'move to the next page docSingle.Close 'close the new document rngPage.Collapse wdCollapseEnd 'go to the next page Loop 'go to the top of the do loop Application.ScreenUpdating = True 'restore the screen updating 'Destroy the objects. Set docMultiple = Nothing Set docSingle = Nothing Set rngPage = Nothing End Sub

[mtupstairs]

Not trying to bump, just wanted to try and post with a little cleaner view of the code. I am still not sure why the tags are not working for me, but I have managed to make it a bit more legible.


Sub SplitIntoPages()
Dim docMultiple As Document
Dim docSingle As Document
Dim rngPage As Range
Dim iCurrentPage As Integer
Dim iPageCount As Integer
Dim strNewFileName As String

Application.ScreenUpdating = False 'Makes the code run faster and reduces screen _ flicker a bit.
Set docMultiple = ActiveDocument 'Work on the active document
Set rngPage = docMultiple.Range 'instantiate the range object
iCurrentPage = 1 'get the document's page count
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
Do Until iCurrentPage > iPageCount
If iCurrentPage = iPageCount
Then rngPage.End = ActiveDocument.Range.End 'last page (there won't be a next page)
Else 'Find the beginning of the next page 'Must use the Selection object. The Range.Goto method will not work on a page
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1 'Set the end of the range to the point between the pages
rngPage.End = Selection.Start
End If rngPage.Copy 'copy the page into the Windows clipboard
Set docSingle = Documents.Add 'create a new document docSingle.Range.Paste 'paste the clipboard contents to the new document 'remove any manual page break to prevent a second blank docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:="" 'build a new sequentially-numbered file name based on the original multi-paged file name and path
strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc") docSingle.SaveAs strNewFileName 'save the new single-paged document
iCurrentPage = iCurrentPage + 1 'move to the next page
docSingle.Close 'close the new document
rngPage.Collapse wdCollapseEnd 'go to the next page
Loop 'go to the top of the do loop
Application.ScreenUpdating = True 'restore the screen updating
'Destroy the objects.
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing

End Sub

[Frosty]

Formatting is actually important... I have no idea if what you're working on is correct or not, but this would be (I have only cleaned up the code, not addressed your problem).

I'm not sure where you're copying this text form... but copying from your vba editor should work just fine. If you don't put tags around it, it won't look pretty... but it would still look like something other than a text file export (your first attempt included option explicit)

Here is the code, formatted differently (I'm not a fan of comments which exist on the same line as real code).

Sub SplitIntoPages()
Dim docMultiple As Document
Dim docSingle As Document
Dim rngPage As Range
Dim iCurrentPage As Integer
Dim iPageCount As Integer
Dim strNewFileName As String

'Makes the code run faster and reduces screen flicker a bit.
Application.ScreenUpdating = False

'Work on the active document
Set docMultiple = ActiveDocument
'instantiate the range object
Set rngPage = docMultiple.Range

iCurrentPage = 1
'get the document's page count
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)

'loop through all of the "pages"
Do Until iCurrentPage > iPageCount
If iCurrentPage = iPageCount Then
'last page (there won't be a next page)
rngPage.End = ActiveDocument.Range.End
Else
'Find the beginning of the next page
'Must use the Selection object. The Range.Goto method will not work on a page
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1
'Set the end of the range to the point between the pages
rngPage.End = Selection.Start
End If
'copy the page into the Windows clipboard
rngPage.Copy

'create a new document
Set docSingle = Documents.Add
'paste the clipboard contents to the new document
docSingle.Range.Paste
'remove any manual page break to prevent a second blank
docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""

'build a new sequentially-numbered file name based on the original multi-paged file name and path
strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc")

'save the new single-paged document
docSingle.SaveAs strNewFileName
'move to the next page
iCurrentPage = iCurrentPage + 1
'close the new document
docSingle.Close

'go to the next page
rngPage.Collapse wdCollapseEnd

Loop 'go to the top of the do loop

Application.ScreenUpdating = True 'restore the screen updating
'Destroy the objects.
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing

End Sub

In general, if you've copied code from somewhere, it's a good idea to attribute it in the code itself, regardless if you then post that code as part of a question elsewhere. Since I don't know where this code comes form, I can't attribute it-- but you could. Just put it at the top of the routine in a comment. If you later change the code so much that the source isn't helpful, drop the attribution if it's no longer recognizable.

Will see if I can address your specific question.

[Frosty]

As far as your real question regarding headers... since you are inexperienced, I need to back up a bit and see if you define things the same way I do. This will be a bit of a tutorial on Word formatting, because I'm not sure you want what you've got.

Headers/Footers are something which exist in a special part of the document, and are section level formatting.

Word basically has 3 different classes/types of formatting:
Character formatting (bold, underline, etc - these formatting properties are stored in each individual character)
Unlike HTML or WordPerfect, where an entire word might be bold because of something analogous to Hello[BoldEnd] -- Word actually stores the "Bold" formatting in each character... so it is analogous [BoldStart]H[BoldEnd][BoldStart]E[BoldEnd][BoldStart]L[BoldEnd][BoldStart]L[BoldEnd][BoldStart]O[BoldEnd]). This is *not* an accurate representation of what going on technically, but it is accurate as a concept.

[B]Paragraph formatting (centered, space before, space after, etc -- is storied in the actual paragraph mark character)

Section formatting (portrait vs. landscape formatting, columns, among many others -- this formatting is all stored in a Section Break character).

Notice that "Page formatting" is not in that list.

Why the long explanation?

Because, if you are referring to "Headers" in the Microsoft Word definition of them, then you don't need the above code at all -- because if your headers change every page, then you must have some section breaks in your document... and I would assume you actually want to break each of your sections into a new document.

However, if your header doesn't change between pages, but the above code is only getting the right "header" in the last document (because the last Paragraph mark of a Word document *also* functions as a Section Break... and that is where header/footer info is stored), then there are a couple of ways to address this.

The easiest is simply to change the code so that

Set docSingle = Documents.Add

Doesn't open a document based on the Normal template, but rather

Set docSingle = Documents.Add (Template:="C:\MyPath\MyTemplate.dotm")

And you use the same template with the right header over and over.

However, if the header changes between documents you want to use this on (but NOT within the document)... you could use your existing docMultiple as the "template"... and instead do something like...

'get a new document based on the existing document
Set docSingle = Documents.Add (Template:=docMultiple.FullName)
'and delete all of the content of the main story, in preparation for the paste
docSingle.Content.Delete

Of course, the right answer depends on your scenario. It may help to get a couple more posts and then post a sample document (no sensitive information please!)

Hope this helps.

[mtupstairs]

Frosty,
Thank you for the reply and I apologize for my delay in responding. I got pulled onto another project for a while. Thank you for the code clean up, I had copied the code directly from the macro when I opened it in Word.

You make an excellent point about the original author attribute. I will add that as well.

I have attached a sample document and here is what I am ultimately trying to accomplish when said macro runs:
Each page would become a separate document with the header and the first (and only) line of text on the page
Ideally, the document would be saved using a file name created by parsing out non allowed characters in the first line of text. For example page one file name would be "section 1 1 a.dotx" ( I had planned to tackle the file name piece once I got the document to create and save correctly.For each document on which this macro is applied, the headers are different. I have been trying some different approaches and I get very close, but just cant seem to nail this one. My closest approach so far has been to get the headers correctly, but not centered.

Any help is appreciated. I have been doing a lot of reading to improve on my skills, but I do not seem to have the skills required yet.

[Frosty]

I haven't looked over your document yet... but why don't you check out Greg Maxey's web-page. There are a lot of useful things over there... like this:
http://gregmaxey.mvps.org/Document_Splitter.htm

You may very well find examples of what you need, with some tweaking... rather than doing it from scratch.