Replace text with matching Mail Merge Field - vba

Question

I would like to create a macro in MS Word that when run searches the document for text that appears in the body of the document that matches the mail merge field name. Once identified it would change the text in the document to the actual matching mail merge field name. For example, if there was a mail merge field named "project_date" and in the Word document there was the text "project_date" the macro would turn the text into the actual mail merge field "project_date".
Ideally, the macro would do this for all mail merge fields that exists at once.
Below is as far as I have come with formulating my desired code.
I found this code here ( https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_other-mso_2007/how-do-i-replace-words-in-a-document-with-a-mail/da323980-7c7d-e011-9b4b-68b599b31bf5 ) but it only will do one specified mail merge field at a time.
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:="(Player 1)")
oRng.Fields.Add oRng, wdFieldMergeField, "Player_1", False
oRng.Collapse wdCollapseEnd
Loop
End With
I recorded this myself, but am not sure how to search and replace text with desired merge field.
With Selection.Find
.Text = "project_name"
.Replacement.Text = "project_name"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Answer 1

The solution for this combines the code for inserting all merge fields into a document with the basic code you found / recorded. Inserting the merge field is moved into the Function that searches the field names in the document. I've set the function up to return the number of times the field is inserted.
The tricky, or special, part of the Function is setting up the Range after a successful Find to continue the search. The end-point of a merge field is still within the merge field, thus the line oRng.MoveStart wdCharacter, 2 is required after collapsing the Range. If the Range stays within the field, the merge field name inside it will be found again, and again, and again...
Sub InsertAllMergeFieldsAtPlaceholders()
Dim doc As word.Document
Dim rng As word.Range
Dim mm As word.MailMergeDataField
Set doc = ActiveDocument
Set rng = doc.content
If doc.MailMerge.MainDocumentType <> wdNotAMergeDocument Then
For Each mm In doc.MailMerge.DataSource.DataFields
Debug.Print ReplaceTextWithMergeField(mm.NAME, rng) & " merge fields inserted for " & mm.NAME
Set rng = doc.content
Next
End If
End Sub
Function ReplaceTextWithMergeField(sFieldName As String, _
ByRef oRng As word.Range) As Long
Dim iFieldCounter As Long
Dim fldMerge As word.Field
Dim bFound As Boolean
With oRng.Find
.ClearFormatting
.Forward = True
.wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
bFound = .Execute(findText:=sFieldName)
End With
Do While bFound
iFieldCounter = iFieldCounter + 1
Set fldMerge = oRng.Fields.Add(oRng, wdFieldMergeField, sFieldName, False)
Set oRng = fldMerge.result
oRng.Collapse wdCollapseEnd
oRng.MoveStart wdCharacter, 2
oRng.End = oRng.Document.content.End
bFound = oRng.Find.Execute(findText:=sFieldName)
Loop
ReplaceTextWithMergeField = iFieldCounter
End Function