Macro to extract the highlighted Text in the document

Sub ScratchMacro()
Dim list
list = ""
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Highlight = True
While .Execute
'MsgBox (oRng.Text)
list = ""
list = list & oRng.Text & "~"
Wend
End With
MsgBox (list)
End Sub