Extract highlighted text to New File

[abroniewski]

Hi there!

I am having some trouble manipulating a word document that will be used in my access database.

What I would like is a macro that will go through the entire document and copy/paste highlighted chunks of text (multi sentence) into a new document. I have a macro that I use to find all acronyms and do the same that I am trying to modify for this purpose. I am not sure what how to define my highlighted text criteria to use instead of the "findText" function.

Any help you guru's out there can give is much appreciated. I've been hitting my head on the wall with this problem for a couple days now!!!!

Dim oPar As Paragraph
Dim myCol As New Collection
Dim bView As Boolean
Dim rText As Range
Dim SDoc As Document
Dim TDoc As Document
Set SDoc = ActiveDocument
Set TDoc = Documents.Add
SDoc.Activate

With Selection
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Text = ""
Do While .Execute(findText:="[A-Z.]{2,}", _
MatchWildcards:=True, _
Wrap:=wdFindStop, Forward:=True) = True
Set rText = Selection.Range
TDoc.Range.InsertAfter rText & vbCr
rText.Collapse wdCollapseEnd
Loop
End With
End With

 

[abroniewski]

Does anyone have some suggestions?
I know that I will be replacing this chunk of text:

Do While .Execute(findText:="[A-Z.]{2,}", _
MatchWildcards:=True, _
Wrap:=wdFindStop, Forward:=True) = True

with something that finds the highlighted text. I want to use an If loop that would start if the text selected is highlighted, but I don't know how to ensure that an entire block of text is copy/pasted.

I guess I am not very comfortable with the With loop and the way that search works...

Any help is much appreciated!
Thanks