Multiple File Find and replace Macro/Saving changes to document

[paulschmits]

I've just finished a macro to Find and replace text in a number of
documents in one or more folders at the same time; does anybody have a
clue how ta make a document which gives me the filenames of the files
in which text was actually found and replaced?

Thanks a lot..

 

[Cindy M -WordMVP-]

I've just finished a macro to Find and replace text in a number of

documents in one or more folders at the same time; does anybody have a
clue how ta make a document which gives me the filenames of the files
in which text was actually found and replaced?

Yes. Run a single "Find" in each document to make sure there's at least
one "hit". If there is, add the current file name information to an
array. Once the file processing is finished, roughly:

Set docFileList = Documents.Add
Set rng = docFileList.Content
For i = lBound(FileListArray()) to UBound(FileListArray)
rng.Text = FileListArray(i) & vbCR
rng.Collapse wdCollapse End
Next

If you need more help than this, you need to show us the code you're
using.

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 8 2004)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question
or reply in the newsgroup and not by e-mail

 

[paulschmits]

Thanks a lot! This is really helpful indeed. just in case someone might
wander into this group looking for the macro, I will post it here
(nevermind the dutch labels..)

Public Sub Zoekenvervang()

'Macro voor het vervangen van tekst in alle documenten in een directory

Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim rngstory As Word.Range
Dim FindText As String
Dim Replacement As String

' Directory selecteren
With Dialogs(wdDialogCopyFile)
If .Display <> 0 Then
PathToUse = .Directory
Else
MsgBox "Afgebroken door gebruiker"
Exit Sub
End If
End With

'Eventuele openstaande documenten sluiten
If Documents.Count > 0 Then
Documents.Close Savechanges:=wdPromptToSaveChanges
End If

FirstLoop = True

If Left(PathToUse, 1) = Chr(34) Then
PathToUse = Mid(PathToUse, 2, Len(PathToUse) - 2)
End If

myFile = Dir$(PathToUse & "*.doc")

While myFile <> ""
'Te vervangen tekst en vervangende tekst opgeven
If FirstLoop = True Then
FindText = InputBox("Geef de tekst op die u wilt verwijderen.", "Batch
Replace Anywhere")
If FindText = "" Then
MsgBox "Afgebroken door gebruiker"
Exit Sub
End If
Tryagain:
Replacement = InputBox("Voer de vervangende tekst in.", "Batch
ReplaceAnywhere ")
If Replacement = "" Then
Response = MsgBox("U heeft geen vervangende tekst ingevoerd. Wilt u de
opgegeven tekst alleen verwijderen?", vbYesNoCancel)
If Response = vbNo Then
GoTo Tryagain
ElseIf Response = vbCancel Then
MsgBox "Afgebroken door gebruiker."
Exit Sub
End If
End If
FirstLoop = False
End If


'Bestanden openenen en tekst vervangen
Set myDoc = Documents.Open(PathToUse & myFile)
MakeHFValid
For Each rngstory In ActiveDocument.StoryRanges
Do
SearchAndReplaceInStory rngstory, FindText, Replacement
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next
'Bestand afsluiten, wijzigingen opslaan.
myDoc.Close Savechanges:=wdSaveChanges
myFile = Dir$()
Wend
End Sub

Public Sub SearchAndReplaceInStory(ByVal rngstory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
Do Until (rngstory Is Nothing)
With rngstory.Find
..ClearFormatting
..Replacement.ClearFormatting
..Text = strSearch
..Replacement.Text = strReplace
..Forward = True
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchAllWordForms = False
..MatchSoundsLike = False
..MatchWildcards = False
..Execute Replace:=wdReplaceAll
End With
Set rngstory = rngstory.NextStoryRange
Loop
End Sub

Public Sub MakeHFValid()
Dim lngJunk As Long
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
End Sub


Cindy M -WordMVP- schreef: