MS Word VBA - Replace text with matching Mail Merge Field

问题

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

回答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

来源：https://stackoverflow.com/questions/50122503/ms-word-vba-replace-text-with-matching-mail-merge-field

标签

ms-word

word-vba

mailmerge