Como posso pesquisar e substituir em vários arquivos do Word?

Estou procurando uma maneira de pesquisar e substituir em muitos arquivos do Word (.doc) (para fins de automação do processo).

O software que encontrei até agora só me permite pesquisar, mas não substituir.

Como posso fazer isso com o Word?

Você pode tentar o VBA Find & Replace (link em cache).

O VBA Find and Replace © fornece um método para localizar e substituir texto em qualquer lugar de um documento (ou coleção de documentos) usando pares de variáveis ​​"localizar" e "substituir" definidas pelo usuário único ou uma lista definida pelo usuário de "localizar" e "substituir" pares. Ele também fornece um método para localizar texto e substituir o texto encontrado por uma entrada definida pelo usuário "AutoTexto" ou "Bloco de Construção".

Com o objetivo de executar várias substituições normais e baseadas em curingas em vários arquivos do MS Word localizados em várias pastas na pasta raiz especificada, criei a macro VBA a seguir. Para usá-lo, você altera o conteúdo das seguintes variáveis ​​(constantes):

• rootPath : pasta raiz na qual estão localizadas pastas contendo documentos do Word.
• findTextsWild e replaceTextsWild : matriz de expressões de localização e substituição baseadas em caracteres curinga.
• findTexts e replaceTexts : matriz de expressões normais de localização e substituição.

Pode ser que você o achará útil :-)

Sub GlobalTextReplacement()
' Root under which all manuals are stored
Dim rootPath As String
rootPath = "c:\Data\Manuals\"

' Find and replace text for wildcard replacement. Performed first.
Dim findTextsWild() As Variant, replaceTextsWild() As Variant
findTextsWild = Array("[ ]{2;}", "[cC]onfiguration[/ ]@[pP]olicy [rR]epository", "[sS]ervlet[- ]@[fF]ilter")
replaceTextsWild = Array(" ", "Configuration/Policy Repository", "Servlet-Filter")

' Find and replace text for normal case insensitive replacement. Performed second.
Dim findTexts() As Variant, replaceTexts() As Variant
findTexts = Array("DirX Access", "Policy Repository", "User Repository", "Servlet", "servletfilter", "SAML assertion", "DirX Access Server", "DirX Access Manager", "Deployment Manager", "Policy Manager", "Client SDK", "^p ", " ^p")
replaceTexts = Array("DirX Access", "Policy Repository", "User Repository", "Servlet", "Servlet-Filter", "SAML assertion", "DirX Access Server", "DirX Access Manager", "Deployment Manager", "Policy Manager", "Client SDK", "^p", "^p")

' Main code
Application.ScreenUpdating = False

Dim dirNames(20) As String
Dim dirNamesCount As Integer
dirNamesCount = 0

Dim dirName As String
dirName = Dir$(rootPath & "*", vbDirectory)
Do Until LenB(dirName) = 0
    Dim dirPath As String
    dirPath = rootPath & dirName
    If ((GetAttr(dirPath) And vbDirectory) = vbDirectory) And (dirName <> ".") And (dirName <> "..") Then
        dirNamesCount = dirNamesCount + 1
        dirNames(dirNamesCount) = dirPath & "\"
    End If
    dirName = Dir$
Loop

Do While dirNamesCount > 0
    Dim fileName As String
    dirName = dirNames(dirNamesCount)
    dirNamesCount = dirNamesCount - 1
    fileName = Dir$(dirName & "*.doc", vbDirectory)
    Do Until LenB(fileName) = 0
        Dim filePath As String
        filePath = dirName & fileName
        fileName = Dir$

        Dim document As document
        Set document = Documents.Open(filePath)
        document.TrackRevisions = True

        document.Select

        Dim i As Integer, maxIndex As Integer
        maxIndex = UBound(findTextsWild)
        For i = LBound(findTextsWild) To maxIndex
            With Selection.Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .Text = findTextsWild(i)
                .Replacement.Text = replaceTextsWild(i)
                .Execute Replace:=wdReplaceAll, Forward:=True, _
                    Wrap:=wdFindContinue, MatchWildcards:=True
            End With
        Next

        maxIndex = UBound(findTexts)
        For i = LBound(findTexts) To maxIndex
            With Selection.Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .Text = findTexts(i)
                .Replacement.Text = replaceTexts(i)
                .Execute Replace:=wdReplaceAll, Forward:=True, _
                    Wrap:=wdFindContinue, MatchCase:=False, MatchWildcards:=False
            End With
        Next

        document.Save
        document.Close
    Loop
Loop

Application.ScreenUpdating = True
End Sub

Não pode ser feito no próprio Microsoft Word?

Está no menu Editar (Word 2003) ou na guia Início / seção Edição (Word 2007)

http://office.microsoft.com/en-us/word/HA012303921033.aspx

Se você não possui o Microsoft Word e está procurando uma alternativa gratuita que o ajude, tente o OpenOffice.org .

Não acho que isso o ajude se você estiver procurando uma maneira de automatizar esse processo.

Notepad ++ É capaz de fazer isso usando "Localizar nos arquivos"

Option Explicit

Public Sub BatchReplaceAll()
    Dim FirstLoop As Boolean
    Dim myFile As String
    Dim PathToUse As String
    Dim myDoc As Document
    Dim Response As Long

    PathToUse = ActiveDocument.Path
    On Error Resume Next
    Documents.Close SaveChanges:=wdPromptToSaveChanges
    FirstLoop = True
    myFile = Dir$(PathToUse & "\*.doc*")

    While myFile <> ""
        Set myDoc = Documents.Open(PathToUse & "\" & myFile)
        If FirstLoop Then
            Application.Dialogs(wdDialogEditReplace).Show
            FirstLoop = False

            Response = MsgBox("Do you want to process the rest of the files in this folder", vbYesNo)
            If Response = vbNo Then Exit Sub
        Else
            With Dialogs(wdDialogEditReplace)
                .ReplaceAll = 1
                .Execute
            End With
        End If
        myDoc.Close SaveChanges:=wdSaveChanges
        myFile = Dir$()
    Wend
End Sub