Find / Replace text using string found within Word document - vba

Question

I've been trying to modify the brilliant example given here with little success. Within the MSWord document, I need to be able to find text like <<TEST>> and recover the string found between << and >> which would return TEST. Ultimately I intend to use this to look up a value against TEST and return a string to be replaced within the Word document. ie. <<TEST>> becomes FRED for example.
Sub Sample()
Dim c As Range
Dim StartWord As String, EndWord As String, TheWord As String
StartWord = "<<": EndWord = ">>"
Set c = ActiveDocument.Content
c.Find.ClearFormatting
c.Find.Replacement.ClearFormatting
With c.Find
.Text = "[\<]{2}*[\>]{2}"
'.Replacement.Text = TheWord
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
c.Find.Execute
While c.Find.Found
Debug.Print c.Text
TheWord = Replace(Replace(c.Text, StartWord, ""), EndWord, "")
Debug.Print TheWord
c.Find.Replacement.Text = TheWord
' Future something here to lookup value based on 'TheWord'
c.Find.Execute Replace:=wdReplaceOne
Wend
End Sub
At the moment, I'm just trying to replace those words like <<TEST>> that are found with the string found within. Although it will find and replace the first instance of the text matching the pattern, it doesn't find others like the example will.
Thanks.

Answer 1

Even if sometimes it is not recommended to use Selection within your code I prefer to use it when running find >> replace actions.
In the following code you will find two solutions- 1st is to replace text with one inside << >> brackets, 2nd is to replace with any text. Do not run both at once, comment one to run the other.
Sub Sample()
Dim c As Range
Dim StartWord As String, EndWord As String, TheWord As String
StartWord = "<<": EndWord = ">>"
ActiveDocument.Range(0, 0).Select
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "[\<]{2}(*)[\>]{2}"
.Replacement.Text = "\1"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'DO NOT RUN BOTH OPTIONS TOGETHER, CHOOSE ONE
'OPTION 1. replace to inside text
'Selection.Find.Execute Replace:=wdReplaceAll
'OPTION 2. replace to any text, here- inside text found with replace function
Do While Selection.Find.Execute
Debug.Print Selection.Text
TheWord = Replace(Replace(Selection.Text, StartWord, ""), EndWord, "")
Debug.Print TheWord
Selection.Text = TheWord
Selection.Collapse WdCollapseDirection.wdCollapseEnd
Loop
End Sub