find/replace in footer

[MG]

I had a post and string in here, and it seems to have
dissapeared, so forgive me for posting a new one.
Graham, you had just given me a public sub to be able to
find and replace all in the headers and footers ... I ran
it, and it did just what you said in the first document,
and proceded to flash up all the rest of the documents in
the folder. The only problem is that only the first
document was changed afterwards ... did the rest not save
with the change?

Thanks for all the help.

 

[Graham Mayor]

I had a post and string in here, and it seems to have
dissapeared, so forgive me for posting a new one.
Graham, you had just given me a public sub to be able to
find and replace all in the headers and footers ... I ran
it, and it did just what you said in the first document,
and proceded to flash up all the rest of the documents in
the folder. The only problem is that only the first
document was changed afterwards ... did the rest not save
with the change?

Thanks for all the help.

I didn't write the code (reproduced below) I only posted it. On the face of
it it looks OK, but the various elements of find and replace across a batch
of documents has been one of those jobs that has been put on a back burner,
so there are various bits of code on the MVPS web site associated with batch
processing. What it needs is an enthusiastic soul with the time available to
bring them together. To this end I have cross-posted this message to the vba
group for comment:

Public Sub BatchReplaceAllInHeaderFooter()

Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long
Dim oSection As Section
Dim oHeader As HeaderFooter
Dim oFooter As HeaderFooter

PathToUse = "D:\My Documents\Temp\"
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
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)

For Each oSection In ActiveDocument.Sections

For Each oHeader In oSection.Headers
If oHeader.Exists Then
.ReplaceAll = 1
.Execute
End If
Next oHeader

For Each oFooter In oSection.Footers
If oFooter.Exists Then
.ReplaceAll = 1
.Execute
End If
Next oFooter

Next oSection
End With
End If

myDoc.Close Savechanges:=wdSaveChanges
myFile = Dir$()

Wend
End Sub



--
<>>< ><<> ><<> <>>< ><<> <>>< <>>< ><<>
Graham Mayor - Word MVP

Web site www.gmayor.com
Word MVP web site www.mvps.org/word
<>>< ><<> ><<> <>>< ><<> <>>< <>>< ><<>

 

[Doug Robbins - Word MVP - DELETE UPPERCASE CHARACT]

Your original post and Graham's response are still there on the third page
when you access the newsgroups through the Web Interface.

Here's some code that does work. It starts by asking you for the folder in
which the files are located and for that to work properly, you must create a
reference to the Microsoft Shell Controls and Automation library by
selecting References from the Tools menu in the Visual Basic Editor. It
then asks you for the text that you want to find and the replacement text.
It will replace that text anywhere in the document. (Some thanks are due
here to Peter Hewett and Jean-Guy Marcil).

Public Sub BatchReplaceAnywhere()
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
Dim oShell As Shell32.Shell
Dim oFolder As Shell32.Folder
Dim EverythingOK As Boolean
Set oShell = New Shell32.Shell
Set oFolder = oShell.BrowseForFolder(0, "Select the folder containing the
files.", 0)
PathToUse = oFolder.Self.Path & "\"
If Documents.Count > 0 Then
Documents.Close Savechanges:=wdPromptToSaveChanges
End If
FirstLoop = True
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
If FirstLoop = True Then
FindText = InputBox("Enter the text that you want to replace.",
"Batch Replace Anywhere")
Replacement = InputBox("Enter the replacement text.", "Batch Replace
Anywhere")
FirstLoop = False
End If
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
myDoc.Close Savechanges:=wdSaveChanges
myFile = Dir$()
Wend
End Sub
Public Sub SREntireDoc()
Dim rngstory As Word.Range

' 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, "test", "text"
' Get next linked story (if any)
Set rngstory = rngstory.NextStoryRange
Loop Until rngstory Is Nothing
Next
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
' 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


--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.
Hope this helps
Doug Robbins - Word MVP

 

[Doug Robbins - Word MVP - DELETE UPPERCASE CHARACT]

This would be better code to use as it won't cause an error if the user
presses Cancel when selecting the folder:

Public Sub BatchReplaceAnywhere()
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
If Documents.Count > 0 Then
Documents.Close Savechanges:=wdPromptToSaveChanges
End If
FirstLoop = True
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
If FirstLoop = True Then
FindText = InputBox("Enter the text that you want to replace.",
"Batch Replace Anywhere")
Replacement = InputBox("Enter the replacement text.", "Batch Replace
Anywhere")
FirstLoop = False
End If
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
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
' 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


--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.
Hope this helps
Doug Robbins - Word MVP

 

[Graham Mayor]

Thanks for the update - but there is something amiss with the code here in
Word 2003. The macro falls over at the last line of the following section.
If you cancel it aborts normally, but whatever you put in the folder
selection box results in a crash. Nor does it appear possible to select a
folder and have it appear in the box. Is this the correct dialog box for
this task?

If you remove the folder choice section and hard code the required folder as
the PathToUse it seems to work OK (though if it could do with some
additional trapping for when it encounters merge documents with attached
data files.)

With Dialogs(wdDialogCopyFile)
If .Display <> 0 Then
PathToUse = .Directory
Else
MsgBox "Cancelled by User"
Exit Sub
End If
End With
If Documents.Count > 0 Then
Documents.Close Savechanges:=wdPromptToSaveChanges
End If
FirstLoop = True
myFile = Dir$(PathToUse & "*.doc")


--
<>>< ><<> ><<> <>>< ><<> <>>< <>>< ><<>
Graham Mayor - Word MVP

Web site www.gmayor.com
Word MVP web site www.mvps.org/word
<>>< ><<> ><<> <>>< ><<> <>>< <>>< ><<>

Doug Robbins - Word MVP - DELETE UPPERCASE CHARACTERS FROM EMAIL

 

[Peter Hewett]

Hi Graham

It sounds like it needs to be in 2 parts. One on file searching (using
recursive algorithms for sub-folders) exploring the various options:

1. Dir/ChDir
2. FileSystemObject
3. Application.FileSearch

And the other on searching and replacing, treating each as a somewhat
separate activity. Like many others I keep library code that does:

1. Simple S+R for the whole document
2. Find all occurrences of search string and perform a custom action for
each successful find (count something, change/add/delete something). I call
this "FindWithAction".
3. Nested S+R
4. S+R using ALL StoryRanges in a document
5. S+R using a specific StoryRanges (say headers or footers)
6. S+R using particular objects (say search all tables)

I realise there's a heck of a lot of ground in the above, so how about
minimal examples on the web page and a template download.

The template could contain multiple modules, each module containing code
for one of the above topics.

Just my thoughts (I go back to work now)!!!

Cheers - Peter

 

[Doug Robbins - Word MVP - DELETE UPPERCASE CHARACT]

Hi Graham,

I developed that using Word 2003 and cannot replicate the problem that you
mention. Stick a MsgBox PathToUse in before the line that causes the
problem and see what it says.

Regards,

Doug Robbins - Word MVP

 

[Graham Mayor]

Now I am completely confused, the message box shows the desired path, but it
still bombs at the next line - whereas the hard coded path of the same name
works fine

--
<>>< ><<> ><<> <>>< ><<> <>>< <>>< ><<>
Graham Mayor - Word MVP

Web site www.gmayor.com
Word MVP web site www.mvps.org/word
<>>< ><<> ><<> <>>< ><<> <>>< <>>< ><<>


Doug Robbins - Word MVP - DELETE UPPERCASE CHARACTERS FROM EMAIL

 

[Doug Robbins - Word MVP - DELETE UPPERCASE CHARACT]

Here's something that should do the trick (makes use of some code supplied
by Peter Hewett)

Public Sub BatchReplaceAnywhere()
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
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")
Replacement = InputBox("Enter the replacement text.", "Batch Replace
Anywhere ")
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


--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.
Hope this helps
Doug Robbins - Word MVP

 

[Doug Robbins - Word MVP - DELETE UPPERCASE CHARACT]

Hi Graham,

Strange. What do you see with

MsgBox Dir$(PathToUse & "*.doc")

in place of the problem line?
--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.
Hope this helps
Doug Robbins - Word MVP

 

[Graham Mayor]

It crashes at that line with the same error message. However if you put
MsgBox PathToUse on the previous line, that shows the correct path. Odd eh?

--
<>>< ><<> ><<> <>>< ><<> <>>< <>>< ><<>
Graham Mayor - Word MVP

Web site www.gmayor.com
Word MVP web site www.mvps.org/word
<>>< ><<> ><<> <>>< ><<> <>>< <>>< ><<>


Doug Robbins - Word MVP - DELETE UPPERCASE CHARACTERS FROM EMAIL

 

[Doug Robbins - Word MVP - DELETE UPPERCASE CHARACT]

Hi Graham,

We finally tracked down that the problem is if a folder name in the path
includes a space, PathToUse is enclosed in quotes, but isn't if there are no
spaces in the folder name. The following amended code overcomes that
problem:

Public Sub BatchReplaceAnywhere()
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")
Replacement = InputBox("Enter the replacement text.", "Batch
ReplaceAnywhere ")
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


--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.
Hope this helps
Doug Robbins - Word MVP

 

[Graham Mayor]

Quotes! Damn! I Missed that.
Now it works
All it needs now is the addition of an error trap to allow cancellation at a
later stage - once the replace is running. Hitting CTRL+Break is not so
elegant

--
<>>< ><<> ><<> <>>< ><<> <>>< <>>< ><<>
Graham Mayor - Word MVP

Web site www.gmayor.com
Word MVP web site www.mvps.org/word
<>>< ><<> ><<> <>>< ><<> <>>< <>>< ><<>



Doug Robbins - Word MVP - DELETE UPPERCASE CHARACTERS FROM EMAIL

 

[Graham Mayor]

The following modified section will do what I want it to do.

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
Replacement = InputBox("Enter the replacement text.", "Batch Replace
Anywhere ")
FirstLoop = False
End If

 

[Doug Robbins - Word MVP - DELETE UPPERCASE CHARACT]

Hi Graham,

In the following version, I have used some If statements to check if
anything was entered into the Input Boxes. If nothing is entered into the
first one, the macro exits without doing anything. If nothing is entered
into the second one, the user is asked if they just want to deleted the text
(entered into the first one) to which they can answer Yes and that is what
will be done; No which will return them to that InputBox or Cancel which
will cause the macro to exit once again without doing anything.

Once the replace is running, the only way to stop it would be to use
Ctrl+Break. Where you meaning to trap that so that if the user pressed it,
they would not be taken to the VBE?

Public Sub BatchReplaceAnywhere()
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
Dim Response
' 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


--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.
Hope this helps
Doug Robbins - Word MVP

 

[Graham Mayor]

Crossed in the mail, but we are both singing from the same hymn sheet

--
<>>< ><<> ><<> <>>< ><<> <>>< <>>< ><<>
Graham Mayor - Word MVP

Web site www.gmayor.com
Word MVP web site www.mvps.org/word
<>>< ><<> ><<> <>>< ><<> <>>< <>>< ><<>


Doug Robbins - Word MVP - DELETE UPPERCASE CHARACTERS FROM EMAIL