Amazing!

http://www.msofficeforums.com/word-vba/12803-find-replace.html#post34254
This is going to help me some day!

Question: 

Is it possible to have MS Word 2003 find and replace text between a certain text? For instance, my document has many lines with text like:

"Warehouse: city 1, Store: Area 1, Address: Avenue 1, PIPE: 15412."
"Warehouse: city 3, Store: Area 5, Address: Avenue 5, IT: 15412."
"Warehouse: city 8, Store: Area 2, Address: Street 4, GATE: 15412."

Notice that first word (Warehouse) and the last text (15412) remain identical in all the lines.
I want to replace everything between 'Warehouse' and '15412' in every line so the end result may look like:
"Warehouse: Village 31, Store: Zone DC, Address: Part 1, CIR: 15412."
"Warehouse: Town 4, Chain: Zone D2C, email: Blvd 5, CIK: 15412."
"Warehouse: Locality A, Grocer: County 7E, snailmail: Building 4, DIMD: 15412."

Answer: 

Given that you want to process multiple documents, try the following macro. Basically, all you need to do is to create an Excel workbook with the Find & Replace strings in columns A & B, respectively, then run the macro and point it to the folder containing the files to be processed. All documents in that folder will be searched and updated. You will need to:

1. supply your own workbook name for the 'StrWkBkNm' variable, 
2. your own worksheet name for the 'StrWkSht' variable 
3. some or all of the path

---

Sub BulkFindReplace()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim iDataRow As Long, xlFList As String, xlRList As String, i As Long
StrWkBkNm = "C:\Users\" & Environ("Username") & "\Downloads\BulkFindReplace.xlsx"
StrWkSht = "Sheet1": strDocNm = ActiveDocument.FullName
If Dir(StrWkBkNm) = "" Then
MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
Exit Sub
End If
On Error Resume Next
'Start Excel
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't start Excel.", vbExclamation
Exit Sub
End If
On Error GoTo 0
With xlApp
'Hide our Excel session
.Visible = False
' The file is available, so open it.
Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm, ReadOnly:=True, AddToMru:=False)
If xlWkBk Is Nothing Then
MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
.Quit: Set xlApp = Nothing: Exit Sub
End If
' Process the workbook.
With xlWkBk
'Ensure the worksheet exists
If SheetExists(xlWkBk, StrWkSht) = True Then
With .Worksheets(StrWkSht)
' Find the last-used row in column A.
iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
' Capture the F/R data.
For i = 1 To iDataRow
' Skip over empty fields to preserve the underlying cell contents.
If Trim(.Range("A" & i)) <> vbNullString Then
xlFList = xlFList & "|" & Trim(.Range("A" & i))
xlRList = xlRList & "|" & Trim(.Range("B" & i))
End If
Next
End With
Else
MsgBox "Cannot find the designated worksheet: " & StrWkSht, vbExclamation
End If
.Close False
End With
.Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Exit if there are no data
If xlFList = "" Then Exit Sub
'Get the folder to process
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
'Process each document in the folder
While strFile <> ""
If strFolder & "\" & strFile <> strDocNm Then
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
'Process each word from the F/R List
With wdDoc
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindContinue
For i = 1 To UBound(Split(xlFList, "|"))
.Text = Split(xlFList, "|")(i)
.Replacement.Text = Split(xlRList, "|")(i)
.Execute Replace:=wdReplaceAll
Next
End With
'Close the document
.Close SaveChanges:=True
End With
End If
'Get the next document
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

Function SheetExists(xlWkBk As Object, SheetName As String) As Boolean
Dim i As Long: SheetExists = False
With xlWkBk
For i = 1 To .Sheets.Count
If .Sheets(i).Name = SheetName Then
SheetExists = True: Exit For
End If
Next
End With
End Function

---