Sub Macro1()
  Dim aRng As Range, sFound As String
  
  Set aRng = ActiveDocument.Range
  With aRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "#*#"
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWholeWord = False
    .MatchWildcards = True
    Do While .Execute = True
      aRng.MoveStart Unit:=wdCharacter, Count:=1
      aRng.MoveEnd Unit:=wdCharacter, Count:=-2
      If Len(aRng.Text) > 32766 Then
        Debug.Print "Oversize Block starting: " & aRng.Paragraphs(1).Range.Text
      Else
        'Do something with the found content
        MsgBox aRng.Text
      End If
      aRng.Collapse Direction:=wdCollapseEnd
      If aRng.End = ActiveDocument.Range.End Then
        Exit Do
      Else
        aRng.End = ActiveDocument.Range.End
        aRng.Select
      End If
    Loop
  End With
End Sub