Sub FindString()
Const strText As String = "string"
Dim orng As Range
Dim oPara As Range
    Set orng = ActiveDocument.Range
    With orng.Find
        Do While .Execute(strText)
            Set oPara = orng.Paragraphs(1).Range 'The paragraph with the string
            If Not oPara.Start = ActiveDocument.Range.Start Then
                oPara.Previous.Paragraphs(1).Range.Delete
            End If
            If Not oPara.Start = ActiveDocument.Range.Start Then
                oPara.Previous.Paragraphs(1).Range.Delete
            End If
            If Not oPara.End = ActiveDocument.Range.End Then
                oPara.Next.Paragraphs(1).Range.Delete
            End If
            If Not oPara.End = ActiveDocument.Range.End Then
                oPara.Next.Paragraphs(1).Range.Delete
            End If
            Exit Do ' Find only the first occurrence
        Loop
    End With
lbl_Exit:
    Exit Sub
End Sub