RE: saving pages of a file into separate files

"MM" wrote:


Some comments inline and my code suggestion at the end...

hello all,

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:

For i = 1 To j

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...

PageNum = PageNum + 1

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

Next i

thanks in advance,

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.

.

Relevant Pages

  • Re: How to replace a string of characters with the count of the ch
    ... Dim AlphabetCountString As String ... I prefer to work with Range objects instead of the Selection whenever ... .MatchWildcards = False ...
    (microsoft.public.word.vba.general)
  • Ws Selection Change Event Code, Copy a Cell problem
    ... The sub below is doing what I want, re: selection. ... Dim RngType As String ... If ChgRow> PaEndRow Then ... Cells(ChgRow, SVrSubscrCol + COfs).Select ...
    (microsoft.public.excel.programming)
  • RE: Emailing With Attachments
    ... Presenting the file list in a combo box for selection ... Dim fso As New FileSystemObject ... 'Try to extract JobNum in the File name ... 'Set objOutlookRecip = .Recipients.Add ...
    (microsoft.public.access.modulesdaovba)
  • Re: Moving to next field with F11 in protected document
    ... a file with the name of the selection and inserts one space and then ... insertion point would move to the location following "postmarked on" ... Dim rgeField As Range ... Dim lngStart As Long ...
    (microsoft.public.word.vba.beginners)
  • Re: Moving to next field with F11 in protected document
    ... macro is invoked with a keyboard hotkey and looks at the characters to ... a file with the name of the selection and inserts one space and then ... Dim rgeField As Range ... Dim lngStart As Long ...
    (microsoft.public.word.vba.beginners)