Editing existing word file using VBA code

[Tarek_CTG]

Dear VBA Code Expert,

I hope all of you are well.

As I am working in HRM department, I have to prepare a lot of appointment letter. I have a fixed format for appointment letter where I edit manually the candidate name, parents name and other extra info. But now I want to prepare it automatically using vba code from excel.

I have a code by which I can open the word file.

Option Explicit
Sub OPENWORD()
Dim WD As Word.Application
Set WD = New Word.Application
WD.Visible = True
WD.Activate
WD.Documents.Open ("C:\Users\Tarek\Desktop\Appointment Letter.docx")
End Sub

Now, in my appointment letter format, I have to edit a lot of things. For example, in my subject line there is written:

Subject: Appointment Letter for the position of “Manager” under the department of "HRM" in "Recruitment" Section.

I have to edit “Manager”, "HRM", "Recruitment" words every time for new appointment letter. Now i want to do it using macro. Like in excel, in sheet 1, Range B1 represents position name (example: manager), Range B2 represents department name (example: HRM), Range B3 represents section name (example: Recruitment). Now I want to copy B1 and paste in my word document where position is mentioned (replace of manager word), B2 where department is mentioned, B3 where section is mentioned etc.

So, I need help for getting vba code. Can anyone help me?

Thanks in advance.

 

[XLfriend777]

Hi Tarek_CTG. I hope this helps get you started. I have wanted to do something like this myself so I did some digging on the web and came up with the code below. I modified it slightly and tested it and to my surprise - IT WORKED for me. Please only try this on an example until you are sure it is working for you. The code opens the MS Word file, searches for the words in Column A of the Excel Spreadsheet and replaces them in the MS Word File with the words in column B. Give this a try on a TEST FILE ONLY!!! Once again - I hope this helps you get started.

Public Sub WordFindAndReplace()
    Dim ws As Worksheet, msWord As Object, itm As Range

    Set ws = ActiveSheet
    Set msWord = CreateObject("Word.Application")

    With msWord
        .Visible = True
        .Documents.Open "C:\Users\Tarek\Desktop\Appointment Letter.docx"
        .Activate

        With .ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            For Each itm In ws.UsedRange.Columns("A").Cells

                .Text = itm.Value2                          'Find all strings in col A

                .Replacement.Text = itm.Offset(, 1).Value2  'Replacements from col B

                .MatchCase = False
                .MatchWholeWord = False

                .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
            Next
        End With
        .Quit SaveChanges:=True
    End With
End Sub