Microsoft Office Forums - View Single Post - Need to find/replace text in many word files

semple.13 · 11-03-2015, 01:20 PM

Thanks for your help everyone; I ended up getting it figured out on my own. I probably should have mentioned that find and replace does not reach embedded documents without first opening them, and that many of the embedded files contain only pictures so changing them to straight text may not have been a good idea.

Likely not the best way to do it, but it works for my purposes:

Code:

Sub Test()
    Dim numObjects As Integer
    Dim oDoc As Document
    Dim strFilename As String
 
    Const strPath As String = "C:\Test Folder\"   'Our folder to look at
    'This makes a directory of files you want to look at (in the folder above, with the file extension specified)
    strFilename = Dir$(strPath & "*.doc*")
 
    'Loops through and checks every applicable file in the folder
    While Len(strFilename) <> 0
        Set oDoc = Documents.Open(strPath & strFilename)    'Makes a Document object for the current file
        oDoc.ActiveWindow.Visible = False
        numObjects = oDoc.InlineShapes.Count                'Count the number of InlineShapes (e.g. OLEs)
 
 
        If numObjects > 0 Then   'If there are any shapes (e.g. embedded objects), interact with them
            For Num = 1 To numObjects   'Iterate through each inline shape via index numbers
                If oDoc.InlineShapes(Num).Type = 1 Then   'If it's an embedded object (InlineShapes().Type = 1 indicates an OLE)
                    oDoc.InlineShapes(Num).OLEFormat.Open   'Open up the embedded object
                    ActiveDocument.ActiveWindow.Visible = False
                    Call FAR    'Find And Replace subroutine
                    ActiveDocument.Close    'Close the embedded object and continue to the next.  Not sure how _
                                            '_ to reference it besides "ActiveDocument" tbh.
                End If
            Next Num
        End If
        Debug.Print oDoc.FullName   'Error handling.
 
        'Closes the Document object and saves changes
        oDoc.Close wdSaveChanges
        'Clears it for the next iteration of the loop
        Set oDoc = Nothing
        strFilename = Dir$()
    Wend
End Sub
 
 
Sub FAR() 'Find And Replace
    ActiveDocument.ActiveWindow.Visible = False
    With Selection.Find 'Throughout the selection (the whole document)..
        .Text = "beep"
        .Replacement.Text = "boop"
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
    End With
End Sub