:
Some comments inline and my code suggestion at the end...
I wrote a code where each individual page of a large file is saved
into separate files. However, I haven’t been able to consistently copy
the headers and footers accordingly. Any suggestion?
The built-in "Page" bookmark never includes the header/footer, unless there
happens to be a section break on the page, or the last ¶ in the doucment is
included.
Here is the segment of my code:
ActiveDocument.Bookmarks.ShowHidden = True
'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
'Gets rid of possible break that is copied at the end of the
page
Selection.TypeBackspace
This systematically deletes the last character, whatever it is...
I do not believe that this is what you want to do... What if there are no
page or section breaks at the end of the page range?
ChangeFileOpenDirectory (MyPath & "\PageToFile")
No need to change the FileOpenDirectory if you are supplying a path in the
SaveAs line...
Do you need this counter? Doesn't "i" already hold a count of the page you
are at...?
ActiveDocument.SaveAs FileName:=prefix & PageNum & ".doc"
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
'Move the selection to the next page in the document
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext,Count:=1
Generally, it is not a good idea to work with the "ActiveDocument" object
when dealing with multiple documents. Create document objects, this way you
are 100% certain which object you are refering to in your code. See my code
below for an example.
Also, normally I avoid the Selection object becasue it is unreliable,
epsecially when handling multiple documents. However, in this case, it is
fairly simple code. There would be a way to use only a range object, but it
would be more complicated than it is now and would not really provide any
advantages. It is one such case where the Selection object is OK.
My suggested code below only copies the main headers/footers. You might want
to add code to transfer "First page" and/or "Odd/even page" headers/footers
as well. Unless you are certain that the documents you are working with only
have the main header/footer type.
Finally, notice how I avoid using the Copy/Paste option, thereby leaving the
user's original clipboard content intact.
Dim i As Long
Dim docCur As Document
Dim docPage As Document
Dim rngCur As Range
Dim rngPage As Range
Dim strPath As String
Set docCur = ActiveDocument
'Save current user selection
Set rngCur = Selection.Range
strPath = "C:\PageToFile\"
docCur.Range(0, 0).Select
For i = 1 To docCur.ComputeStatistics(wdStatisticPages)
Set rngPage = Selection.Bookmarks("\page").Range.FormattedText
'Open new document and create document object
Set docPage = Documents.Add
With docPage
.Range.FormattedText = rngPage
'Gets rid of possible break [Chr(12)] that ,might be at the end of
the Page
If AscW(docPage.Characters.Last.Previous) = 12 Then
docPage.Characters.Last.Previous.Delete
End If
'Copy headers/footers
.Sections(1).Headers(wdHeaderFooterPrimary).Range.FormattedText = _
rngPage.Sections(1).Headers(wdHeaderFooterPrimary).Range.FormattedText
'Delete the last ¶
.Sections(1).Headers(wdHeaderFooterPrimary).Range.Characters.Last.Delete
.Sections(1).Footers(wdHeaderFooterPrimary).Range.FormattedText = _
rngPage.Sections(1).Footers(wdHeaderFooterPrimary).Range.FormattedText
.Sections(1).Footers(wdHeaderFooterPrimary).Range.Characters.Last.Delete
.SaveAs strPath & i & ".doc"
.Close savechanges:=wdDoNotSaveChanges
End With
'Move the selection to the next page in the document
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1
Next i
'Reset original user selection
rngCur.Select
If you want a perfect match, you probably have to consider page Setup
options as well. Transfer margin sizes, page orientation, paper size, etc..
Good luck.- Hide quoted text -
- Show quoted text -
