find with wild cards and add into CC

[sylvio]

Good day

I cannot understand what is the problem with the code below.
I am trying to put every line of the text in separate content controls:

<paragraph mark> just some text <paragraph mark>
<paragraph mark> another piece of some text <paragraph mark>
<paragraph mark> just some text <paragraph mark>



With wild card "[!^13]@some*^13" the code looks for complete string embraced by paragraph marks and puts it into CC, but somehow the code falls into endless loop. With Ctrl+Break I can see that the job is done, so in general the code is ok.
What is the point?

Sub Add_CC_w_Title()

Dim oCC As Word.ContentControl
Dim doc As Word.Document
Dim oRng As Range
Set doc = ActiveDocument
Set oRng = ActiveDocument.Range
    
    With oRng.Find
            .Text = "[!^13]@some*^13"
            .Wrap = wdFindContinue
            .MatchWildcards = True
            
            While .Execute
                'oRng.Font.Color = wdColorRed
                Set oCC = doc.ContentControls.Add(wdContentControlText, oRng)
                oCC.Title = "title"
            Wend
    End With

End Sub

[macropod]

Try:

Sub Add_CC_w_Title()
Dim oCC As Word.ContentControl
With ActiveDocument.Range
  With .Find
    .Text = "[!^13]@some*^13"
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    Set oCC = .ContentControls.Add(wdContentControlText, .Duplicate)
    oCC.Title = "title"
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
End Sub

[sylvio]

Just perfect! Thank you.