Find and replace across multiple word documents


I have a bunch of .doc and .docx files which regularly need editing (text and images) is there a way of setting up a macro to make things a bit easier?

I found the below solution which would of been ideal for editing text across multiple documents:
Public Sub MassReplace()
    With Application.FileSearch
        .LookIn = "C:\"             ' where to search
        .SearchSubFolders = True    ' search the subfolders
        .FileName = "*.doc"         ' file pattern to match

        ' if more than one match, execute the following code
        If .Execute() > 0 Then
            ' for each file you find, run this loop
            For i = 1 To .FoundFiles.Count
                ' open the file based on its index position
                Documents.Open FileName:=.FoundFiles(i)

                ' search and replace the address
                With selection.Find
                    .Text = "OldAddress"
                    .MatchCase = True
                    .Replacement.Text = "NewAddress"
                End With
                selection.Find.Execute Replace:=wdReplaceAll

                ' replace e-mail address
                With selection.Find
                    .Text = "Oldemail"
                    .Replacement.Text = "Newemail"
                End With
                selection.Find.Execute Replace:=wdReplaceAll

                ' save and close the current document
                ActiveDocument.Close wdSaveChanges
            Next i
            ' if the system cannot find any files
            ' with the .doc extension
            MsgBox "No files found."
        End If
    End With
End Sub

Open in new window

Unfortunately the  "Application.FileSearch" was removed with Ms office 2007.

is there anything you can suggest? my VBA knowledge is limited.
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

jambomamboAuthor Commented:
I have also tried to get this to work, no errors display when running the macro but no changes are made to the documents.
Sub DoLangesNow()
Dim file
Dim path As String
Dim strFolder As String
Dim strSubFolder As String
Dim strFile As String
Dim colSubFolders As New Collection
Dim varItem As Variant

 ' Parent folder including trailing backslash
     strFolder = "C:\macro"

     ' Loop through the subfolders and fill Collection object
     strSubFolder = Dir(strFolder & "*", vbDirectory)
     Do While Not strSubFolder = ""
         Select Case strSubFolder
             Case ".", ".."
                 ' Current folder or parent folder - ignore
             Case Else
                 ' Add to collection
                 colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
         End Select
         ' On to the next one
         strSubFolder = Dir
     ' Loop through the collection
     For Each varItem In colSubFolders
         ' Loop through word docs in subfolder
         'YOU MUST EDIT THIS if you want to change the files extension
         strFile = Dir(strFolder & varItem & "\" & "*.docx")
         Do While strFile <> ""
         Set file = Documents.Open(FileName:=strFolder & _
                 varItem & "\" & strFile)

' Start of macro 1replace text GS-XXXAB  with GS-1624AB
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Application.WindowState = wdWindowStateNormal
    With Selection.Find
        .Text = "this"
        .Replacement.Text = "that"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
' End of macro 1
' Saves the file
' set file to next in Dir
strFile = Dir
     Next varItem
 End Sub

Open in new window

the instruction says to include a trailing backslash in the strFolder string literal.  You have not done that.
This is a simplified approach.
Option Explicit

Sub DoLangesNow()
    Dim oDoc As Document
    Const cPath As String = "C:\macro\"
    Dim oWSH As Object
    Dim RC As Long
    Set oWSH = CreateObject("")
    RC = oWSH.Run("cmd.exe /c dir /s /b " & cPath & "*.doc > " & cPath & "dirlist.txt", 0, True)
    Open cPath & "dirlist.txt" For Input As #1
    Do Until EOF(1)
        Line Input #1, strFile
        Set oDoc = Documents.Open(FileName:=strFolder & varItem & "\" & strFile)

        oDoc.Content.Find.Execute findtext:="GS-XXXAB", replacewith:="GS-1624AB", Replace:=wdReplaceAll

        'Close and Save the file
        oDoc.Close True
    Kill cPath & "dirlist.txt"
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
jambomamboAuthor Commented:
Great help, worked fine thank you. Would you have any advice on how to do this for inserted images?
I suggest you open a new image-related question.  Be sure to include a link to this question in your new question.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Word

From novice to tech pro — start learning today.