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

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

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.

Thanks for your help
0
spar-kle
Asked:
spar-kle
  • 9
  • 9
1 Solution
 
GrahamSkanCommented:
Are the pages separated by Page breaks or Next Page Section Breaks?
0
 
spar-kleAuthor Commented:
Print layout it shows multiple pages, but outline and draft view only shows one page break
0
 
GrahamSkanCommented:
Any chance of seeing a sample?
0
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
spar-kleAuthor Commented:
Here's a sample document with all actual content removed.
Pages 2-4 may be updated
Data-Sheet-T-C.docx
0
 
GrahamSkanCommented:
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

Open in new window

The file name for the master document and for the ipnut and output folders are all hard coded.
0
 
spar-kleAuthor 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
 
spar-kleAuthor 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
 
GrahamSkanCommented:
I've been away today, but hope to look at this again tomorrow (in 12+ hours time)
0
 
GrahamSkanCommented:
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
 
spar-kleAuthor 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
 
GrahamSkanCommented:
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

Open in new window

0
 
spar-kleAuthor 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
 
GrahamSkanCommented:
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

Open in new window

0
 
spar-kleAuthor Commented:
When the first Input file is opened, the message comes up "only 3 page breaks found"
0
 
GrahamSkanCommented:
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

Open in new window

0
 
spar-kleAuthor 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
 
GrahamSkanCommented:
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
 
spar-kleAuthor Commented:
Thanks for your help, excellent.
really appreciated.
Des
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 9
  • 9
Tackle projects and never again get stuck behind a technical roadblock.
Join Now