#1
|
|||
|
|||
Multi-Doc Find/Replace, Including Headers/Footers & Textboxes
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 Last edited by macropod; 05-02-2014 at 02:47 PM. Reason: Deleted unnecessary quote of entire posted cited. |
#2
|
||||
|
||||
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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
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 |
#4
|
||||
|
||||
Quote:
Quote:
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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
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 |