Выделить определенную информацию

Sub SearchInText()

  Dim bSel, eSel As Long
  Dim bSel1, eSel1 As Long
  Dim rng As Range
  
  bSel = ActiveDocument.Content.Start
  eSel = ActiveDocument.Content.End
  Set rng = ActiveDocument.Range(Start:=bSel, End:=eSel)
  rng.Select
  bSel1 = 0
  eSel1 = ActiveDocument.Content.End
  
  Do While True
    With Selection.Find
      .Text = "поблагодарить"
      If .Execute Then
          bSel = Selection.Start
          eSel = Selection.End
          'MsgBox (CStr(bSel) + " " + CStr(eSel))
          
          If eSel1 <> ActiveDocument.Content.End Then
            bSel1 = eSel1
            eSel1 = bSel
            'MsgBox (CStr(bSel1) + " " + CStr(eSel1))
            Selection.Start = bSel1
            Selection.End = eSel1
          Else
            bSel1 = 0
            eSel1 = bSel
            'MsgBox (CStr(bSel1) + " " + CStr(eSel1))
            Selection.Start = bSel1
            Selection.End = eSel1
          End If
          Selection.Font.Bold = wdToggle
          
          eSel1 = eSel
          
          Selection.Start = bSel
          Selection.End = eSel

      Else
          'MsgBox ("Поиск завершен")
          bSel1 = eSel1
          eSel1 = ActiveDocument.Content.End
          'MsgBox (CStr(bSel1) + " " + CStr(eSel1))
          Selection.Start = bSel1
          Selection.End = eSel1
          Selection.Font.Bold = wdToggle
          ' Снятие выделения
          Selection.MoveRight Unit:=wdCharacter, Count:=1
          ' Выход из цикла и завершение работы макроса
          Exit Sub

      End If
    End With
  Loop
End Sub