Performing Search & Replace in Word Documents Headers from Access 2

[DaveTaylor]

I am trying to do a search & replace from access using automation. The following code works in the main body of a document but will not update the page header:

Dim varReplaceWith As Variant

varReplaceWith = Eval(myrs![fldbatch])
varReplaceWith = IIf(IsNull(varReplaceWith), " ", _
CStr(varReplaceWith))

With docword.Content.Find

With .Replacement
.ClearFormatting
.Font.Bold = True
.Font.Italic = True
.Font.Size = 16
End With

.Execute findtext:="BATCH", _
replacewith:=varReplaceWith, Format:=True, _
Replace:=wdReplaceAll

End With

Any help would be greatly appreciated.

 

[JustinEzequiel]

an MS Word document consists of StoryRanges representing the different parts of a document (e.g., the main text body, comments, footnotes, footers, and headers)

you are using the content property of the word document (docword.Content)
this is equivalent to docword.StoryRanges(wdMainTextStory)

you should use one of the following instead:

docword.StoryRanges(wdPrimaryHeaderStory)
docword.StoryRanges(wdFirstPageHeaderStory)
docword.StoryRanges(wdEvenPagesHeaderStory)

 

[DaveTaylor]

I thank you very much for your help, I am still unsure of how to carry out the actual search and replace using this other property. The methods I am using in docword.content are now not valid. I am fairly new to automation with word.

 

[JustinEzequiel]

' the following code will execute your search and replace all throughout your document (including in the main text body, headers, footers, footnotes, etc.)

that is, if this is what you want

' Dim StoryRange As Word.Range ' use if you've referenced the MS Word object library
Dim StoryRange As Object

For Each StoryRange In docword.StoryRanges
  With StoryRange.Find
    
    With .Replacement
      .ClearFormatting
      .Font.Bold = True
      .Font.Italic = True
      .Font.Size = 16
    End With
    
    .Execute findtext:="BATCH", _
    replacewith:=varReplaceWith, Format:=True, _
    Replace:=wdReplaceAll
    
  End With
Next StoryRange

' if all you want is replace text only in your headers then use this

Dim StoryRange As Object

For Each StoryRange In docword.StoryRanges
  If StoryRange.StoryType = wdEvenPagesHeaderStory Or _
     StoryRange.StoryType = wdFirstPageHeaderStory Or _
     StoryRange.StoryType = wdPrimaryHeaderStory Then
    With StoryRange.Find
      
      With .Replacement
        .ClearFormatting
        .Font.Bold = True
        .Font.Italic = True
        .Font.Size = 16
      End With
      
      .Execute findtext:="BATCH", _
      replacewith:=varReplaceWith, Format:=True, _
      Replace:=wdReplaceAll
      
    End With
  End If
Next StoryRange

' either way, i don't see a need for you to change the rest of your code; just change the part that you posted

 

[DaveTaylor]

That is absolutely fantastic ! This code does exactly what I want. Again I thank you very much for this excellent help.

 

[DaveTaylor]

One more minor point if you don't mind :

Only Header sections 1 & 2 are updated. Is there anything else that needs to be added to update all sections in document.

Thanks

 

[JustinEzequiel]

you can e-mail me the file if you want so that i can have a look (j dot ezequiel at spitech dot com)

 

[DaveTaylor]

I will post this finished code for reference should anybody need something similiar.
This works in performing search and replace in Word 97 document headers where there are multiple document sections.

Dim rgLoop As Word.Range
Dim secLoop As Word.section
Dim hfLoop As Word.HeaderFooter
Dim bCheck As Boolean

' now search headers
' for some reason, checking the LinkToPrevious property
' doesn't always work properly, but assigning to a Boolean
' first does

For Each secLoop In docword.Sections
For Each hfLoop In secLoop.Headers
bCheck = hfLoop.LinkToPrevious
If Not bCheck Then

With hfLoop.Range.Find

With .Replacement
.ClearFormatting
.Font.Bold = True
.Font.Size = 8
End With

.Execute findtext:="INSERT BATCH HERE", _
Replacewith:=varReplaceWith, Format:=True, _
Replace:=wdReplaceAll

.Execute findtext:="INSERT USERID HERE", _
Replacewith:=varReplaceid, Format:=True, _
Replace:=wdReplaceAll

End With

End If
Next hfLoop

Next secLoop

 

[DaveTaylor]

Also see the following:

http://www.scottm.dircon.co.uk/vbatips/word/selrange/search.htm