John,
Unlike Find and Replace, a macro like yours would only find and replace in
the document main story. I think Word2003 has 11 stories (textboxes are one
of them). You will need to adapt your code so that it loops through each
document story (or at least textboxes). The following may provide you with
enough to work through it:
Public Sub BatchFindReplaceAnywhere()
'Macro by Doug Robbins - 1st March 2004
'with additional input from Peter Hewett to replace text in all the
documents in a folder
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
' Get the folder containing the files
With Dialogs(wdDialogCopyFile)
If .Display <> 0 Then
PathToUse = .Directory
Else
MsgBox "Cancelled by User"
Exit Sub
End If
End With
'Close any documents that may be open
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 <> ""
'Get the text to be replaced and the replacement
If FirstLoop = True Then
FindText = InputBox("Enter the text that you want to replace.", "Batch
Replace Anywhere")
If FindText = "" Then
MsgBox "Cancelled by User"
Exit Sub
End If
Tryagain:
Replacement = InputBox("Enter the replacement text.", "Batch ReplaceAnywhere
")
If Replacement = "" Then
Response = MsgBox("Do you just want to delete the found text?",
vbYesNoCancel)
If Response = vbNo Then
GoTo Tryagain
ElseIf Response = vbCancel Then
MsgBox "Cancelled by User."
Exit Sub
End If
End If
FirstLoop = False
End If
'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, FindText, Replacement
' 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, _
ByVal strSearch As String, _
ByVal strReplace As String)
'This routine supplied by Peter Hewett
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()
'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
Public Sub BatchReplaceDocProperties()
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Expr1 As String
'close any open documents
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
' Get the folder containing the files
MsgBox "Click OK. When the Copy dialog box appears drill down to the
applicable folder and click on Open.", , "User Instructions"
With Dialogs(wdDialogCopyFile)
If .Display <> 0 Then
PathToUse = .Directory
Else
MsgBox "Cancelled by User"
Exit Sub
End If
End With
' PathToUse = "D:\My Documents\Word Documents\Word Tips\Macros\"
If Left(PathToUse, 1) = Chr(34) Then
PathToUse = Mid(PathToUse, 2, Len(PathToUse) - 2)
End If
Expr1 = InputBox("Enter the Document Subject:", "Subject")
'Set the directory and type of file to batch process
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
'Open document
Set myDoc = Documents.Open(PathToUse & myFile)
'Ensure Word will sense change and resave
myDoc.Saved = False
'Set DocProperty
With myDoc
.BuiltInDocumentProperties("Title").Value = Expr1
End With
myDoc.Close SaveChanges:=wdSaveChanges
'Process next file in folder
myFile = Dir$()
Wend
End Sub
