Multi-Doc Find/Replace, Including Headers/Footers & Textboxes

konopca · #1 05-02-2014, 09:02 AM

Hello all. Just wondering how to update the code in Post #2 (https://www.msofficeforums.com/word-...html#post45854) to search and replace text. I gave it several trys but was unsuccessful. The text I'm searching for would be in the headers and the text and in text boxes.

Carol

macropod · #2 05-02-2014, 03:06 PM

To process the headers and the shapes in them, you would need additional code. For example:

Code:

Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
Dim Rng As Range, Sctn As Section, HdFt As HeaderFooter, Shp As Shape
Const strFnd As String = "Find String": Const strRep As String = "Replace String"
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, _
    AddToRecentFiles:=False, Visible:=False)
  With wdDoc
     For Each Rng In .StoryRanges
       Call Update(Rng, strFnd, strRep)
     Next
    For Each Sctn In .Sections
      For Each HdFt In Sctn.Headers
        With HdFt
          If .LinkToPrevious = False Then
              'Process the header
            With .Range.Find
              Call Update(Rng, strFnd, strRep)
            End With
              'Process textboxes etc in the header
            For Each Shp In .Shapes
              With Shp.TextFrame
                If .HasText Then
                  With .TextRange.Find
                    Call Update(Rng, strFnd, strRep)
                  End With
                End If
              End With
            Next
          End If
        End With
      Next
    Next
    .Close SaveChanges:=True
  End With
  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

Sub Update(Rng As Range, strFnd As String, strRep As String)
With Rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = strFnd
  .Replacement.Text = strRep
  .Forward = True
  .Wrap = wdFindStop
  .Format = False
  .Execute Replace:=wdReplaceAll
End With
End Sub

konopca · #3 05-05-2014, 09:14 AM

Paul
I removed the x from this line. Is that okay? I have Word 2010 but I open all my files in compatiability mode.
strFile = Dir(strFolder & "\*.doc", vbNormal)

And when I recorded a macro for search and replace I got the following code but I'm not sure how much of it to incorporate. I also need:

1) All the headers to be changed
2) All the occurrences in the text layer, and
3) All the text boxes (which are not in the header)

Code:

 
Sub test()
'
' test Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "04-15-09"
.Replacement.Text = "05-05-14"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Thanks for your help.
Carol

macropod · #4 05-05-2014, 03:18 PM

Quote:

Originally Posted by konopca

Paul
I removed the x from this line. Is that okay? I have Word 2010 but I open all my files in compatiability mode.
strFile = Dir(strFolder & "\*.doc", vbNormal)

Yes, that's fine

Quote:

And when I recorded a macro for search and replace I got the following code but I'm not sure how much of it to incorporate.

Try:

Code:

Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
Dim Sctn As Section, HdFt As HeaderFooter, Shp As Shape
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, _
    AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    'Process the body
    Call Update(.Range)
    'Process textboxes etc in the body
    For Each Shp In .Shapes
      With Shp.TextFrame
        If .HasText Then
          Call Update(.TextRange)
        End If
      End With
    Next
    For Each Sctn In .Sections
      For Each HdFt In Sctn.Headers
        With HdFt
          If .LinkToPrevious = False Then
            'Process the header
            Call Update(.Range)
          End If
        End With
      Next
    Next
    .Close SaveChanges:=True
  End With
  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
 
Sub Update(Rng As Range)
With Rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "04-15-09"
  .Replacement.Text = "05-05-14"
  .Forward = True
  .Wrap = wdFindStop
  .Format = False
  .Execute Replace:=wdReplaceAll
End With
End Sub

You'll note that this is a slightly different approach, with the macro I previously gave you now calling one based on the one you posted. This way, there's only one set of Find/Replace code to maintain.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
headers/footers	scot	Word	3	05-22-2015 09:45 AM
Macro for find/replace (including headers and footers) for multiple documents	jpb103	Word VBA	2	05-16-2014 04:59 AM
Odd and Even Headers/Footers	sarineochaos	Word	1	02-04-2014 06:15 PM
Replace text of textboxes	tng	Word VBA	1	12-22-2013 05:23 PM
Headers and Footers	teza2k06	Word	1	05-14-2013 11:07 AM