Search code examples
excelvba

Replace and insert text in a Word document using Excel VBA


I want to replace text and add one line on the same open Word document.

I tried this piece of code but it doesn't work.

Sub open_word_replace_text()

Dim book1 As Word.Application
Dim sheet1 As Word.Document

Set book1 = CreateObject("word.application")
book1.Visible = True

Set sheet1 = book1.Documents.Open("Template.docx")

With sheet1.Content.Find
    .Text = "prova"
    .Replacement.ClearFormatting
    .Replacement.Text = (Sheets("Sheet2").Range("A2").Value) & " " &      (Sheets("Sheet2").Range("B2").Value)
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
    .Forward = True
End With

'the following part must be write after the replace as new line on the      word document and same paragraph
 
sheet1.Content.Text = (Sheets("Sheet2").Range("C2").Value)

end sub

Solution

  • Microsoft documentation:

    Selection.TypeText method (Word)

    Selection.EndKey method (Word)

    Option Explicit
    Sub open_word_replace_text()
        Dim wdApp As Word.Application
        Dim wdDoc As Word.Document
        Dim Sht As Worksheet
        Set Sht = Sheets("Sheet2")
        Set wdApp = CreateObject("word.application")
        wdApp.Visible = True
    '    Set wdDoc = wdApp.Documents.Open("Template.docx")
        ' The more reliable way to open file
        Set wdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\Template.docx")
        With wdDoc.Content.Find
            .ClearFormatting
            .MatchCase = False
            .Forward = True
            .Wrap = wdFindContinue
            .Text = "prova"
            .Replacement.ClearFormatting
            .Replacement.Text = Sht.Range("A2").Value & " " & Sht.Range("B2").Value
            .Execute Replace:=wdReplaceAll
        End With
        'the following part must be write after the replace as new line on the word document and same paragraph
        With wdApp.Selection
            .EndKey Word.wdStory
            .TypeParagraph ' Inserts a new blank paragraph
            .TypeText Sht.Range("C2").Value
        End With
    '    wdDoc.Save
    '    wdDoc.Close
    '    wdApp.Quit
    End Sub
    
    

    Update:

    Option Explicit
    Sub open_word_replace_text()
        Dim wdApp As Word.Application
        Dim wdDoc As Word.Document
        Dim Sht As Worksheet
        Set Sht = Sheets("Sheet2")
        Set wdApp = CreateObject("word.application")
        wdApp.Visible = True
    '    Set wdDoc = wdApp.Documents.Open("Template.docx")
        ' The more reliable way to open file
        Set wdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\Template.docx")
        With wdDoc.Content.Find
            .ClearFormatting
            .MatchCase = False
            .Forward = True
            .Wrap = wdFindContinue
            .Text = "prova"
            .Replacement.ClearFormatting
            .Replacement.Text = Sht.Range("A2").Value & " " _
                & Sht.Range("B2").Value & _
                Chr(13) & Sht.Range("C2").Value
            .Execute Replace:=wdReplaceAll
        End With
    End Sub