I have a question about refining a Find and Replace Loop.

I am working on a VBA word indexer where I need to 1) find the word 2)
First Cap and bold the word 3) Index the word.

Simple example:

Word to index "Apples"

Sample text:  Apples, apples, apples,

Code:
Dim rngstory As Word.Range
Set rngstory = ActiveDocument.Range
With rngstory.Find
 .ClearFormatting
 .Replacement.ClearFormatting
 .MatchWildcards = False
 .MatchWholeWord = True
 .Wrap = wdFindStop
 .Text = "Apples"
 .Replacement.Text = .Text
 .Replacement.Font.Bold = True
 Do
   .Execute Replace:=wdReplaceOne
   rngstory.Collapse Direction:=wdCollapseEnd
   If .Found Then
     ActiveDocument.Indexes.MarkEntry _
     Range:=rngstory, Entry:=.Text
   End If
 Loop While .Found
End With
End Sub

Without the IF statement the last instance of apples in the sample text
is indexed twice.  I figured out why that is and used the IF statement
to resolve it.  My question:  Is there a more appropriate method for
defining a Do Loop for this application such that the Loop is executed
only IF the item is found?  I thought something like:

.Found = True
Do While .Found
...

But that doesn't work.  Thanks.