Paul, I'm not sure you should rely on the .StoryRanges collection in Word when dealing with headers/footers-- to me it seems completely broken when using it in a For each loop. Turn off Link to Previous in the primary header of section 2, drop some text in there.. and then try your code. You won't find it, becaue the for each loop completely skips it. I *think* you can use the .NextStoryRange method to get around this bug, but I use some sort of structure like the following function to iterate through all of theI think the .StoryRanges collection is broken in Word (at least, in Word 2010). I believe it creates the .StoryRanges collection based on the setup of the first section, and so can ignore other sections when they aren't linked... so if you have the following set up:1. Section 1, no first page different, no even pages2. Section 2, first page different, primary header not linked to previousThe for each loop for .StoryRanges fails to access the Primary Header in section 2.If you set up a multi-section document put some text in the headers/footers that you are showing... it should pretty easily demonstrate the problem.For the OP -- I would use my fGetStoryRanges function with the default options (the way the second test routine does), and then have a separate function process each unique range. In terms of optimizing the code -- it's definitely better to check a boolean property of whether a header/footer range is linked than to use a string test on the range. That said, if you end up with something working- then go for it. But I would *not* trust the For Each loop on StoryRanges, especially on large documents where you're unlikely to notice a failure (as opposed to the simple documents you'd probably test on).I agree with Fumei -- post whatever you come up with, the below
Sub TestBadStoryRanges() Dim r As Range For Each r In ActiveDocument.StoryRanges Select Case r.StoryType Case wdEvenPagesFooterStory, wdEvenPagesHeaderStory, wdFirstPageFooterStory, wdFirstPageHeaderStory, _ wdPrimaryFooterStory, wdPrimaryHeaderStory ' r.Select Debug.Print Replace(r.Paragraphs.First.Range.Text, vbCr, "") End Select NextEnd SubSub TestGoodStoryRanges() Dim r As Range For Each r In fGetStoryRanges Debug.Print Replace(r.Paragraphs.First.Range.Text, vbCr, "") NextEnd Sub'----------------------------------------------------------------------------------------------'The MS StoryRanges collection is fundamentally broken when trying to search headers/footers'as well, since a for each loop doesn't return unlinked headers'This is an attempt to generate an accurate collection of story ranges for the passed document.'Uses the activedocument (if any) if no document is passed'doesn't currently return ranges of any textboxes'----------------------------------------------------------------------------------------------Public Function fGetStoryRanges(Optional oDoc As Document, _ Optional bHeadersFootersOnly As Boolean = True, _ Optional bAddHeadersFootersOnlyIfShowing As Boolean = True) As Collection Dim colRet As Collection Dim rngStory As Range Dim hf As HeaderFooter Dim oSec As Section On Error GoTo l_err Set colRet = New Collection If oDoc Is Nothing Then Set oDoc = ActiveDocument End If 'easy story ranges, if desired If bHeadersFootersOnly = False Then For Each rngStory In oDoc.StoryRanges Select Case rngStory.StoryType Case wdCommentsStory, wdFootnotesStory, wdEndnotesStory, wdMainTextStory colRet.Add rngStory.Duplicate End Select Next End If 'headers/footers (for each not reliable!!) For Each oSec In oDoc.Sections For Each hf In oSec.Headers 'don't add linked ranges If hf.LinkToPrevious = False Or oSec.Index = 1 Then 'don't add hidden ranges, unless specified If bAddHeadersFootersOnlyIfShowing And hf.Exists _ Or bAddHeadersFootersOnlyIfShowing = False Then colRet.Add hf.Range.Duplicate End If End If Next For Each hf In oSec.Footers 'don't add linked ranges If hf.LinkToPrevious = False Or oSec.Index = 1 Then 'don't add hidden ranges, unless specified If bAddHeadersFootersOnlyIfShowing And hf.Exists _ Or bAddHeadersFootersOnlyIfShowing = False Then colRet.Add hf.Range.Duplicate End If End If Next Nextl_exit: Set fGetStoryRanges = colRet Exit Functionl_err: 'any errors, blackbox and return an empty collection Set colRet = New Collection Resume l_exitEnd Function