#1
|
|||
|
|||
Replace words within headers in multiple document
I am trying to create a macro that will go through and replace text in a header found in multiple documents.
The program opens the find and replace function where you put in your criteria and hit "replace all" then hit "close", it will then ask you if you want to do the same for all the documents in the folder, after hitting "Yes" it crashes.The code will successfully change the first documents text but then crashes word with the next document. Please help and thank you. Here is the code: Code:
Option Explicit Public Sub BatchReplaceAll() Dim FirstLoop As Boolean Dim myFile As String Dim PathToUse As String Dim myDoc As Document Dim Response As Long Dim myStoryRange As Range PathToUse = "C:\Test\" 'Error handler to handle error generated whenever 'the FindReplace dialog is closed On Error Resume Next 'Close all open documents before beginning Documents.Close SaveChanges:=wdPromptToSaveChanges 'Boolean expression to test whether first loop 'This is used so that the FindReplace dialog will 'only be displayed for the first document FirstLoop = True 'Set the directory and type of file to batch process myFile = Dir$(PathToUse & "*.doc") While myFile <> "" 'Open document Set myDoc = Documents.Open(PathToUse & myFile) If FirstLoop Then 'Display dialog on first loop only 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 'On subsequent loops (files), a ReplaceAll is 'executed with the original settings and without 'displaying the dialog box again For Each myStoryRange In ActiveDocument.StoryRanges If myStoryRange.StoryType <> wdMainTextStory Then With Dialogs(wdDialogEditReplace) .ReplaceAll = 1 .Execute End With Do While Not (myStoryRange.NextStoryRange Is Nothing) Set myStoryRange = myStoryRange.NextStoryRange With Dialogs(wdDialogEditReplace) .ReplaceAll = 1 .Execute End With Loop End If Next myStoryRange End If 'Close the modified document after saving changes myDoc.Close SaveChanges:=wdSaveChanges 'Next file in folder myFile = Dir$() Wend End Sub Last edited by Carchee; 12-18-2013 at 02:13 PM. |
#2
|
|||
|
|||
Code:
Sub ReplaceTextInHeader() Dim oHF As HeaderFooter Dim oSection As Section Dim myfle PathToUse As String PathToUse = "C:\Test\" myfile = Dir(PathToUse & "*.doc") Do While myfle <> "" Documents.Open (PathToUse & myfile) For Each oSection In ActiveDocument.Sections For Each oHF In oSection.Headers oHF.Range.Text = Replace(oHF.Range.Text, "Revision", "Final") Next Next ActiveDocument.Close SaveChanges:=wdSaveChanges myfile = Dir() Loop End Sub The code above replace the word "Revision" with "Final" in ALL headers, in ALL documents in the folder. |
#3
|
||||
|
||||
Try something based on:
Code:
Sub UpdateDocumentHeaders() Application.ScreenUpdating = False Dim strFolder As String, strFile As String, wdDoc As Document 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.StoryRanges(wdPrimaryHeaderStory).Find .ClearFormatting .Text = InputBox("Text to Replace", "Old String") .Replacement.Text = InputBox("Replacement Text", "New String") .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = True .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute Replace:=wdReplaceAll End With wdDoc.Close SaveChanges:=True 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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#4
|
|||
|
|||
Yeah, I guess it depends n whether you actually need some sort of input on what to replace.
|
#5
|
||||
|
||||
The essential differences between our respective codings are:
1. yours processes all headers in a pre-defined folder, using pre-defined find/replace strings; 2. mine processes only the primary headers in a user-defined folder, with user-defined find/replace strings.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#6
|
|||
|
|||
Splitting hairs Paul. The OP had a defined folder, so I used the same one. I was simply pointing out that IF it was a simple replace (i.e. there was no actual need for the dialog to get inputs), it could be done with a simple replace.
As for primary header versus all headers...shrug...again just pointing it out as it is unknown whether it is needed, or not. Carchee, neither macropod or I have dealt with the logo issue, but hopefully you can see the variety of approach and come up with something that will work for you. HINT: keep a copy of the GetFolder function Paul posted as it comes in very handy in a huge number of situations. |
#7
|
||||
|
||||
Hi Gerry,
Not splitting hairs - merely describing for the OP's benefit the essential differences between the two - yours is more automatic and in some respects more comprehensive, mine is more flexible. Both have their places.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
Quote:
I think a good take away for anyone reading the thread is that most of the possible bases are covered. You want flexibility in what is being replaced via an input, use the InputBox for .Text (and Replacement.Text). You want flexibility in where to get the documents via an input, use the GetFolder function. You want a simple replacement, use a simple Replace. You want all headers (or by extension footers) processed, my example demonstrates this. Between us pretty much all possibilities have been demonstrated, as they can be mixed and matched any way you want. |
#9
|
|||
|
|||
Wow this helps out a lot. Thank you fumei and macropod.
Although fumei's code would work it's not quite what I'm looking for, I'm leaning more towards macropod's code. I did fail to mention that the "replaced text" will be different for every folder that I execute the program on, so a simple replace would not be practical or at least I'm too lazy to go into the code each time and change it. macropod's code is set up to ask the "Text to Replace" and the "Replacement Text" for each file within the folder which is also impractical for my situation as the text being replaced and the new text will be the same in each file. For this reason my code asked the user only once what should be replaced with what. Sometimes there will be upwards of fifty files needing change and that would take awhile if I had to type it each time. So my next step is to take your code and apply it to mine and it should work....hopefully. I'm fairly new to the coding business. Again thank you for your help. |
#10
|
||||
|
||||
With either set of code, modifications to allow a single prompt per folder are fairly simple. With mine, for example, to do that and process any first-page & even-page headers as well, change the UpdateDocumentHeaders sub to:
Code:
Sub UpdateDocumentHeaders() Application.ScreenUpdating = False Dim strFolder As String, strFile As String, wdDoc As Document Dim strFnd As String, strRep As String, wdStory(), i As Long strFolder = GetFolder If strFolder = "" Then Exit Sub strFnd = InputBox("Text to Replace", "Old String") strFile = Dir(strFolder & "\*.doc", vbNormal) strRep = InputBox("Replacement Text", "New String") wdStory = Array(wdPrimaryHeaderStory, wdFirstPageHeaderStory, wdEvenPagesHeaderStory) While strFile <> "" Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With wdDoc On Error Resume Next For i = LBound(wdStory) To UBound(wdStory) MsgBox wdStory(i) With .StoryRanges(wdStory(i)).Find .ClearFormatting .Replacement.ClearFormatting .Text = strFnd .Replacement.Text = strRep .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = True .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute Replace:=wdReplaceAll End With Next On Error GoTo 0 .Close SaveChanges:=True End With strFile = Dir() Wend Set wdDoc = Nothing Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#11
|
|||
|
|||
Why do you use StoryRanges?
|
#12
|
|||
|
|||
This works nicely with some modification to get exactly what I want. Thank you so much......Solved!
|
#13
|
||||
|
||||
So that I don't need to process headers by Section. The code should be more efficient that way for multi-section documents.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#14
|
|||
|
|||
fumei, with my original code I was under the impression that I needed to use StoryRanges in order to search within the header.
|
#15
|
|||
|
|||
sheesh, I really am getting old and stupid. Mind you the rare times I bulk action headers I often am doing a test for specific states in specific headers...but still...
doh! |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Find and highlight multiple words in MS Word document | AtaLoss | Word VBA | 37 | 09-22-2021 12:04 PM |
Highlight and then replace multiple words | redhin | Word VBA | 5 | 03-05-2013 05:42 AM |
Macro to replace few words in the document | ubns | Word VBA | 7 | 08-16-2012 10:33 PM |
Multiple Headers in Same Worksheet | Tom | Excel | 3 | 05-18-2011 03:22 PM |
Multiple Headers | boutells | Word | 1 | 06-05-2009 12:04 AM |