How to paste values on every page of word document from Excel VBA?

Question

I have a long list of word-paths and start- and endtags in Excel. I need to open the word document using the path specified in Excel, and paste a start-tag on the beginning of every page, and an end-tag on every end of a page. Every document has three pages. I'm struggling with Excel VBA and cant seem to get it to work. Can anyone help me?

I need my code to run through the list, opening the file, copy the starttag on the beginning of each page, and the end tag on the end of each page, save and close the document and go on to the next document.

My excel structure

Until now, I managed to open my excel document

Sub startword()
    Set WordApp = CreateObject("word.Application")
    Path = Range("B2").Value & Range("F5").Value
        WordApp.Documents.Open Path
        
        WordApp.Visible = True
End Sub

And I was able to copy and paste values to a NEW document.

Sub copyrange()

    'declare word vars
    Dim WrdApp As Word.Application
    Dim WrdDoc As Word.Document
    'Path = Range("B2").Value & Range("F5").Value
    
    'declare excel vars
    Dim ExcRng As Range
    
    'create new word instance
    Set WrdApp = New Word.Application
        WrdApp.Visible = True
        WrdApp.Activate
        
    Set WrdDoc = WrdApp.Documents.Add
    
    
    
    'create reference to range i want to copy
    Set ExcRng = ActiveSheet.Range("B2:E6")
    
    'copy the range and wait for a bit
    ExcRng.Copy
    Application.Wait Now() + #12:00:01 AM#
    
    'paste the object in word
    WrdDoc.Paragraphs(1).Range.PasteExcelTable LinkedToExcel:=True, WordFormatting:=True, RTF:=False
    
      WrdApp.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
      
       WrdDoc.Paragraphs(1).Range.PasteSpecial Link:=True, DataType:=wdPasteOLEObject
    
    'clear clipboard
    Application.CutCopyMode = False

End Sub

The range is totally random

PART TWO OF THE QUESTION I'm struggling with the next piece of my code. I need to extract the contents between the first start and end tag (with the tag included) and move them to doc 1, same with page 2 to doc2, page 3 to doc 3. So I'll get three documents. doc1 with all the first pages of my documents, doc 2 with all the 2nd pages etc. I've made an attempt to find/select the code, but it selects the first and the last page, not the first one.

This is my current code for opening the word docs one by one:

Sub SelectRangeBetween()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")                  'Change to the correct sheetname

    Dim wrdApp As Word.Application
    Dim WrdDoc As Word.Document
    
    Set wrdApp = New Word.Application                       '
    wrdApp.Visible = True                                   'set to false for higher speed
      
    
    Const StarttagColumn = "C"                              'Edit this for the column of the starttag.
    Const EndtagColumn = "D"                                'Edit this for the column of the endtag.
    Const FilelocationColumn = "E"                          'Edit this for the column of the Filelocation.
    Const startRow As Long = 5                              'This is the first row of tags and filenames
    'Const endRow As Long = 140                             'uncomment if you want a fixed amount of rows (for ranges with empty cells)
    Dim endRow As Long                                      'comment out if const-endrow is used
    endRow = ws.Range("B" & Rows.Count).End(xlUp).Row       'comment out if const-endrow is used

     Dim i As Long
     For i = startRow To endRow
        Dim wrdPath As String
        wrdPath = ws.Cells(i, FilelocationColumn).Value2    '
        
        If wrdPath <> vbNullString Then                     '
            If Dir(wrdPath) <> vbNullString Then            '
                Dim startTag As String                      '
                Dim endTag As String                        '
                
                startTag = ws.Cells(i, StarttagColumn).Value2   '
                endTag = ws.Cells(i, EndtagColumn).Value2       '
                
                Set WrdDoc = wrdApp.Documents.Open(wrdPath) '
            With wrdApp
            '.Documents.Add
            ' .Visible = True
            ' Types the text
            '.Selection.HomeKey Unit:=wdStory
            '.Selection.TypeText Text:="Hello and Goodbye"
            ' The Real script
            'Dim StartWord As String, EndWord As String
            'StartWord = "Hello"
            'EndWord = "Goodbye"
            With .ActiveDocument.Content.Duplicate
             .Find.Execute FindText:=startTag & "*" & endTag, MatchWildcards:=False
             .MoveStart wdCharacter, Len(StardWord)
             .MoveEnd wdCharacter, -Len(EndWord)
             .Select ' Or whatever you want to do
            End With
            
            End With
            With WrdDoc
            .Close
            End With
            End If
        End If
    Next i
End Sub

Expanding on Mr. Wu's comment... Every Word document has three headers and three footers in each section, built in. addbalance.com/usersguide/sections2007.htm#Recap_of_Header/… For a three-page document you may want to use this structure. Different First Page + Different Even and Odd. You would place information for the first page in the First-Page header/footer, for the second page in the Even-Page header/footer, and for the third page in the Odd-Page header/footer. — Charles Kenyon
– Charles Kenyon, Commented Aug 4, 2021 at 13:34
No, unfortunately not. my document generator wont be able to find tags there — Daniël Vegter
– Daniël Vegter, Commented Aug 4, 2021 at 13:36
Or since there's only 1 start-tag and end-tag for each document, we can paste it to 1 header/footer and let the 3 pages use the same one. — Raymond Wu
– Raymond Wu, Commented Aug 4, 2021 at 13:36
@Daniël In that case then each page will have 2 extra paragraphs, it can potentially ruin your document's content (layout wise), is that ok? And typically, we do need the asker to provide their code attempt, do you have one? If so then edit your question and provide your code attempt. — Raymond Wu
– Raymond Wu, Commented Aug 4, 2021 at 13:38

Raymond Wu · Accepted Answer · 2021-08-04 14:30:01Z

0

Try this version, I suggest you try with a small batch of documents first as the document will be saved immediately after pasting the tag. (comment out the lines if you do not want to save and/or close):

Option Explicit

Private Sub PasteTagsToDocument()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") 'Change to the correct name
    
    Const startRow As Long = 5
    Dim endRow As Long
    endRow = ws.Range("B" & Rows.Count).End(xlUp).Row
    
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    
    Set wrdApp = New Word.Application
    wrdApp.Visible = True
                    
    Dim i As Long
    For i = startRow To endRow
        Dim wrdPath As String
        wrdPath = ws.Cells(i, 2).Value2
        
        If wrdPath <> vbNullString Then
            If Dir(wrdPath) <> vbNullString Then
                Dim startTag As String
                Dim endTag As String
                
                startTag = ws.Cells(i, 3).Value2
                endTag = ws.Cells(i, 4).Value2
                
                Set wrdDoc = wrdApp.Documents.Open(wrdPath)
                With wrdDoc
                    .Range(0, 0).InsertBefore startTag & vbNewLine
                    .GoTo(wdGoToPage, wdGoToAbsolute, 2).InsertBefore endTag & vbNewLine & startTag & vbNewLine
                    .GoTo(wdGoToPage, wdGoToAbsolute, 3).InsertBefore endTag & vbNewLine & startTag & vbNewLine
                    .Range.Paragraphs.Last.Range.InsertAfter vbNewLine & endTag
                    
                    .Save 'Comment out if you do not want to save
                    .Close 'Comment out if you do not want to close the document
                End With
            Else
                If MsgBox("File don't exist. " & vbNewLine & wrdPath & vbNewLine & "Click Ok to Continue or Cancel to stop the macro.", vbOKCancel) = vbCancel Then Exit For
            End If
        End If
    Next i
    
    Set ws = Nothing
    
    Set wrdDoc = Nothing
    wrdApp.Quit
    Set wrdApp = Nothing
    
    MsgBox "Complete!"
End Sub

answered Aug 4, 2021 at 14:30

Raymond Wu

3,4272 gold badges9 silver badges20 bronze badges

Sign up to request clarification or add additional context in comments.

5 Comments

Daniël Vegter Over a year ago

Woa that worked like a charm! Thank you very very much!

Raymond Wu Over a year ago

@Daniël Welcome, feel free to ask if you don't understand any part.

Daniël Vegter Over a year ago

Hi @raymond ! I'm struggeling with the next piece of my code. I need to extract the contents between the first start and end tag (with the tag included) and move them to doc 1, same with page 2 to doc2, page 3 to doc 3. so i'll get three documents. doc1 with all the first pages of my documents, doc 2 with all the 2nd pages etc, etc. I've made an attempt to find/select the code, but it selects the first and the last page, not the first one. Could you help me out?

Raymond Wu Over a year ago

@Daniël Hello, I'll love to help but seeing that this is a new question, can you make a new question with your code attempt?

Daniël Vegter Over a year ago

hi @raymond Wu here's the new question stackoverflow.com/questions/68679223/…

Collectives™ on Stack Overflow

How to paste values on every page of word document from Excel VBA?

1 Answer 1

5 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

5 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related