VBA code to find word file, then find and replace words

[defaultrush]

I have a excel sheet with the names of word documents (nearly 10000), old and new numbers, I need a VBA code to search the word documents from a folder and search the old number from the excel sheet and replace them with the corresponding new numbers.

 

[John_w]

You haven't given any details about the layout of your sheet, so I've assumed column A contains the file name of the Word document without the ".docx" extension, column B contains the old number to find and column C contains the replacement new number, all starting at row 2. Change the docsFolder path as needed.

Test the macro on a copy of your folder containing some of the Word documents.

Public Sub Find_and_Replace_In_Word_Docs()
    
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    Dim docsFolder As String
    Dim ws As Worksheet
    Dim r As Long
    
    docsFolder = "C:\path\to\docs\folder\"   'CHANGE THIS
    
    If Right(docsFolder, 1) <> "\" Then docsFolder = docsFolder & "\"
    
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    If Err Then
        Set WordApp = New Word.Application
    End If
    On Error GoTo 0
    
    Set ws = ActiveSheet
    For r = 2 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        Set WordDoc = WordApp.Documents.Open(docsFolder & ws.Cells(r, "A").Value & ".docx")
        With WordDoc.Content.Find
            .Text = ws.Cells(r, "B").Value
            .Replacement.Text = ws.Cells(r, "C").Value
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll
        End With
        WordDoc.Save
        WordDoc.Close
    Next

    MsgBox "Done"
    
End Sub

 

[defaultrush]

You haven't given any details about the layout of your sheet, so I've assumed column A contains the file name of the Word document without the ".docx" extension, column B contains the old number to find and column C contains the replacement new number, all starting at row 2. Change the docsFolder path as needed.

Test the macro on a copy of your folder containing some of the Word documents.

Public Sub Find_and_Replace_In_Word_Docs()
   
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    Dim docsFolder As String
    Dim ws As Worksheet
    Dim r As Long
   
    docsFolder = "C:\path\to\docs\folder\"   'CHANGE THIS
   
    If Right(docsFolder, 1) <> "\" Then docsFolder = docsFolder & "\"
   
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    If Err Then
        Set WordApp = New Word.Application
    End If
    On Error GoTo 0
   
    Set ws = ActiveSheet
    For r = 2 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        Set WordDoc = WordApp.Documents.Open(docsFolder & ws.Cells(r, "A").Value & ".docx")
        With WordDoc.Content.Find
            .Text = ws.Cells(r, "B").Value
            .Replacement.Text = ws.Cells(r, "C").Value
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll
        End With
        WordDoc.Save
        WordDoc.Close
    Next

    MsgBox "Done"
   
End Sub

I am getting this error while running the macro

 

[defaultrush]

I am getting this error while running the macro

 

[John_w]

In the VBA editor, Tools -> References -> Microsoft Word n.00 Object Library, where n is your Word version.

The same Word object declarations are in your original code, so I thought you already had the reference.

 

[defaultrush]

In the VBA editor, Tools -> References -> Microsoft Word n.00 Object Library, where n is your Word version.

The same Word object declarations are in your original code, so I thought you already had the reference.

Awesome works like a charm, Thanks a lot

Just a suggestion, it would be great if it would throw a error if it was not able to find the word specified in the excel to replace, now it just moves on to the next file.

 

[John_w]

Replace the .Execute line with:

            If Not .Execute(Replace:=wdReplaceAll) Then
                MsgBox "'" & ws.Cells(r, "B").Value & "' not found in " & ws.Cells(r, "A").Value, vbExclamation
            End If