Go Premium for a chance to win a PS4. Enter to Win

x
• Status: Solved
• Priority: Medium
• Security: Public
• Views: 217

# How can I replace pages 2-4 in all Word documents in a folder with the pages in the current open file using a macro?

I have around 100+ .doc and .docx files in a folder that contain the company terms & conditions on pages 2-4.
Very occasionally these terms change.
The pages contain text boxes and images.

If I create a document with new terms & conditions, can I replace all pages 2-4 in a designated folder with pages 2-4 in the open document?

I would like to achieve this with a macro which will facilitate the easy changing of files, en masse, in the future.

0
spar-kle
• 9
• 9
1 Solution

Commented:
Are the pages separated by Page breaks or Next Page Section Breaks?
0

Author Commented:
Print layout it shows multiple pages, but outline and draft view only shows one page break
0

Commented:
Any chance of seeing a sample?
0

Author Commented:
Here's a sample document with all actual content removed.
Pages 2-4 may be updated
Data-Sheet-T-C.docx
0

Commented:
I had hoped that the pages would be positively delimited, This code looks checks the page number of the paragraphs. This should work unless a page overflows in the middle of a paragraph.
Sub UpdateDocs()
Dim strMasterDoc As String
Dim strUpdateDoc As String
Dim MasterDoc As Document
Dim strFolder1 As String
Dim strFolder2 As String
Dim rngMaster As Range
Dim rngUpdate As Range
Dim UpdateDoc As Document

strMasterDoc = "I:\Allwork\ee\28481125\Data-Sheet-T-C.docx"
strFolder1 = "I:\Allwork\ee\28481125\Input\"
strFolder2 = "I:\Allwork\ee\28481125\Output\"

Set MasterDoc = Documents.Open(strMasterDoc)
Set rngMaster = GetPages(MasterDoc, 2, 4)
rngMaster.Copy
strUpdateDoc = Dir$(strFolder1 & "*.docx") Do Until Len(strUpdateDoc) = 0 Set UpdateDoc = Documents.Open(strFolder1 & strUpdateDoc) Set rngUpdate = GetPages(UpdateDoc, 2, 4) rngUpdate.Paste UpdateDoc.SaveAs strFolder2 & strUpdateDoc UpdateDoc.Close wdDoNotSaveChanges strUpdateDoc = Dir$()
Loop
End Sub

Function GetPages(Doc As Document, iStart As Integer, iEnd As Integer) As Range
Dim para As Paragraph
Dim rng As Range

For Each para In Doc.Paragraphs
Select Case para.Range.Information(wdActiveEndPageNumber)
Case iStart
Set GetPages = para.Range.Duplicate
Case iEnd + 1
GetPages.End = para.Range.Start
Exit Function
End Select
Next para
End Function

The file name for the master document and for the ipnut and output folders are all hard coded.
0

Author Commented:
Thanks Graham
That works perfectly for amending page 2 only.

Pages 3 and 4 are not amended unfortunately.

As an alternative method, would it be possible to delete all pages on input file, except page 1, then insert page breaks and copy the three new pages?
0

Author Commented:
...or alternatively, how about if the first page of each input file is copied to the master file and then saved in the output file with the original name?
0

Commented:
I've been away today, but hope to look at this again tomorrow (in 12+ hours time)
0

Commented:
I have modified your sample document by adding another page, so that there now five pages. I have added text at the start of each page with the Page number, and then created two versions, one with the word 'Old' after the page number and the other with 'New'. After running the macro code, the word 'New' can be seen on pages 2 to 4 only of the old version.
Hopefully this will work for you. If it does, but it still doesn't work for you with your own files, then it might be to do with what is on the following page (5) , or how page 4 is ended. If that is the case, can you past a further sample with another page, please?
Data-Sheet-T-C-Old.docx
Data-Sheet-T-C-New.docx
0

Author Commented:
Thanks Graham
Definitely getting there.

When I use the Data-Sheet-T-C-New.docx as my template it was adding a blank page after the first, so I removed the page break on page 1 which resolved this issue.

However, although the three new pages are being added, the original pages (2-4) are still in the output file, though they are displaced to pages 5-6
0

Commented:
I notice that the pages are separated with manual page breaks, so in this version, we use the Find object to look for these page breaks.
Sub UpdateDocs()
Dim strMasterDoc As String
Dim strUpdateDoc As String
Dim MasterDoc As Document
Dim strFolder1 As String
Dim strFolder2 As String
Dim rngMaster As Range
Dim rngUpdate As Range
Dim UpdateDoc As Document
strMasterDoc = "I:\Allwork\ee\28481125\Data-Sheet-T-C_New.docx"
strFolder1 = "I:\Allwork\ee\28481125\Input\"
strFolder2 = "I:\Allwork\ee\28481125\Output\"

Set MasterDoc = Documents.Open(strMasterDoc)
Set rngMaster = GetPages(MasterDoc, 2, 4)
rngMaster.Copy
strUpdateDoc = Dir$(strFolder1 & "*.docx") Do Until Len(strUpdateDoc) = 0 Set UpdateDoc = Documents.Open(strFolder1 & strUpdateDoc) Set rngUpdate = GetPages(UpdateDoc, 2, 4) rngUpdate.Paste UpdateDoc.SaveAs strFolder2 & strUpdateDoc UpdateDoc.Close wdDoNotSaveChanges strUpdateDoc = Dir$()
Loop
End Sub

Function GetPages(Doc As Document, iStart As Integer, iEnd As Integer) As Range
Dim iPage As Integer
Dim rng1 As Range
Dim rng2 As Range
Dim rng As Range
Debug.Print Doc.Name

Set rng1 = Doc.Range.Duplicate
iPage = 1
With rng1.Find
.Text = "^m"
Do While .Execute
Set rng2 = rng1.Duplicate
iPage = iPage + 1
Select Case iPage
Case iStart
Set rng = rng2
Case Is >= iEnd + 1
rng.End = rng2.End
Set GetPages = rng.Duplicate
Exit Function
End Select
Loop
End With
End Function

0

Author Commented:
Thanks Graham

This code gives me a Run-time error 91: object variable or With block not set
with reference to  rngMaster.Copy

So I presume the  GetPages Function is unable to locate pages.
0

Commented:
Not enough, anyway.
This version issues a diagnostic message if that is the case.
Function GetPages(Doc As Document, iStart As Integer, iEnd As Integer) As Range
Dim iPage As Integer
Dim rng1 As Range
Dim rng2 As Range
Dim rng As Range

Set rng1 = Doc.Range.Duplicate
iPage = 1
With rng1.Find
.Text = "^m"
Do While .Execute
Set rng2 = rng1.Duplicate
iPage = iPage + 1
Select Case iPage
Case iStart
Set rng = rng2
Case Is >= iEnd + 1
rng.End = rng2.End
Set GetPages = rng.Duplicate
Exit Function
End Select
Loop
End With
MsgBox "Only " & iPage - 1 & " page breaks found"
End
End Function

0

Author Commented:
When the first Input file is opened, the message comes up "only 3 page breaks found"
0

Commented:
Yes. There were only three the document that you sent. There were only four pages, so I guessed that in removing page 5 onwards, you had also removed a page break. In my version of the test document I had inserted a page break to create a fifth page. Without it, extra text lies under the textboxes on page 4.

I still don't know what causes  the overflow to page 5 in your non-redacted documents. However, this macro version tries to find  four page breaks, but if it fails, it uses the techniques from the first version. That is to step through the paragraphs until it finds page 5.
Function GetPages(Doc As Document, iStart As Integer, iEnd As Integer) As Range
Dim iPage As Integer
Dim rng1 As Range
Dim rng2 As Range
Dim rng As Range

Set rng1 = Doc.Range.Duplicate
iPage = 1
With rng1.Find
.Text = "^m"
Do While .Execute
Set rng2 = rng1.Duplicate
iPage = iPage + 1
Select Case iPage
Case iStart
Set rng = rng2

Case Is > iEnd + 1
'rng.End = rng2.End
'Set GetPages = rng.Duplicate
Exit Function
Case Else
rng.End = rng2.End
Set GetPages = rng.Duplicate

End Select
Loop
End With
Dim para As Paragraph
Set rng2 = rng.Duplicate
rng2.Collapse wdCollapseEnd
rng2.End = Doc.Range.End
For Each para In rng2.Paragraphs
If para.Range.Information(wdActiveEndPageNumber) = iEnd + 1 Then
GetPages.End = para.Range.Start
Exit For
End If
Next para

End Function

0

Author Commented:
Thanks for your continued support Graham, really appreciated
I'm using your file "Data-Sheet-T-C-New.docx" with 5 pages.
It is now so very close to what is required.

All of the new pages are inserted correctly into the input files, and pages 1-4 are exactly correct.
However, page 3 of each of the input files is displaced to page 5
0

Commented:
I'm sorry, but I don't have any more guesses.

If you are  worried about the open view of the documents the you could consider posting to me personally. My email address is obfuscated  (to avoid email harvesters)  in my profile.
0

Author Commented: