Easy-to-maintain array for multiple find/replace operations?

[Edward Mendelson]

I am trying to write a macro that will find approximately a hundred
different strings in a document and replace them with other strings (replace
foo with bar; replace with sun with moon; replace Mars with Venus, etc.,
etc.). I've found two examples of how to do this in earlier postings (shown
below), but I wonder if anyone can suggest an efficient way of setting out
the array so that I can simply list the find and replace strings next to
each other, without providing a count of the exact number (because I will
change the number of strings as I find new ones to use), in other words
something like this:

find:=foo repl:=bar
find:=sun repl:=moon
find:=Mars repl:=Venus
etc etc

Can anyone suggest the right way to handle this? Many thanks for any help.

Edward Mendelson

(sample code below
========================================
Sub ReplacingCharacters()
' By Erwin Bauens from this newsgroup

Dim FindString As Variant
Dim ReplaceString As Variant
Dim Index As Integer
Dim myRange As Range

' you should devise some way to get
' the special characters and their
' replacements into the arrays by
' reading a document or spreadsheet
FindString = Array("a", "b", "c")
ReplaceString = Array("x", "y", "z")

For Index = 0 To UBound(FindString)
Set myRange = ActiveDocument.Range
With myRange.Find
.Text = FindString(Index)
.Replacement.Text = ReplaceString(Index)
.Format = False
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
Next Index
End Sub

=========================================

Sub DoSubstitute()
'also by Erwin Bauens

Dim myArray(2, 1) As String
Dim myRange As Range
Dim i As Integer

myArray(0, 0) = "eviva"
myArray(0, 1) = "long live"
myArray(1, 0) = "el"
myArray(1, 1) = "the"
myArray(2, 0) = "Zorro"
myArray(2, 1) = "fox"

'please not that the first dimension of the array is used to store the
'number of words to be replaced
'the second dimension holds the actual words and their replacement
Set myRange = ActiveDocument.Range
For i = 0 To 2
myRange.Find.Execute FindText:=myArray(i, 0), ReplaceWith:=myArray(i, 1), _
Replace:=wdReplaceAll
Next 'i
Set myRange = Nothing
End Sub

 

[Greg Maxey]

Edward,

I use this:

Public Sub BatchFileMultiFindAndReplace()



'This macro is a collection of work by Doug Robbins, Peter Hewett, Klaus
Linke, Graham Mayor

'and me



Dim myFile As String

Dim PathToUse As String

Dim myDoc As Document

Dim rngstory As Word.Range

Dim ListArray

Dim WordList As Document



'Close any documents that may be open

If Documents.Count > 0 Then

Documents.Close SaveChanges:=wdPromptToSaveChanges

End If



' Change the path and filename in the following to suit where you have your
list of words

Set WordList = Documents.Open(FileName:="D:\My Documents\Word Documents\Word
Tips\Find and Replace List.doc")

'Your list of words should be a two column word table.



ListArray = WordList.Tables(1).Range.Text

ListArray = Split(ListArray, Chr(13) & Chr(7))

WordList.Close

' Get the folder containing the files. I you only have one file then put it
by itself in a folder

With Dialogs(wdDialogCopyFile)

If .Display <> 0 Then

PathToUse = .Directory

Else

MsgBox "Cancelled by User"

Exit Sub

End If

End With



If Left(PathToUse, 1) = Chr(34) Then

PathToUse = Mid(PathToUse, 2, Len(PathToUse) - 2)

End If



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



While myFile <> ""

'Open each file and make the replacement

Set myDoc = Documents.Open(PathToUse & myFile)

'Fix the skipped blank Header/Footer problem

MakeHFValid

'Iterate through all story types in the current document

For Each rngstory In ActiveDocument.StoryRanges

'Iterate through all linked stories

Do

SearchAndReplaceInStory rngstory, ListArray

' Get next linked story (if any)

Set rngstory = rngstory.NextStoryRange

Loop Until rngstory Is Nothing

Next

'Close the file, saving the changes.

myDoc.Close SaveChanges:=wdSaveChanges

myFile = Dir$()

Wend



End Sub

Public Sub SearchAndReplaceInStory(ByVal rngstory As Word.Range, ByRef
ListArray As Variant)

'This routine supplied by Peter Hewett and modified by Greg Maxey



Dim Source As Document

Dim i As Integer

Dim Find As Range

Dim Replace As Range

Set Source = ActiveDocument

Source.Activate

For i = LBound(ListArray) To UBound(ListArray) - 1 Step 3

With rngstory.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = ListArray(i)

.Replacement.Text = ListArray(i + 1)

..Wrap = wdFindContinue

..Format = False

..MatchCase = True

..MatchWholeWord = False

..MatchAllWordForms = False

..MatchSoundsLike = False

..MatchWildcards = False

..Execute Replace:=wdReplaceAll

End With

Next i

End Sub

Public Sub MakeHFValid()

'And this too

Dim lngJunk As Long

' It does not matter whether we access the Headers or Footers property.

' The critical part is accessing the stories range object

lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType

End Sub

 

[Malcolm Smith]

On my site I have a find and replace tool which I once knocked up for
someone on one of these forums. You may find it useful, though you may
need to modify it slightly.

- Malc
www.dragondrop.com