用匹配的邮件合并字段替换文本

Question

我想在 MS Word 中创建一个宏，它在运行时会在文档中搜索与邮件合并字段名称匹配的文档正文中出现的文本。一旦被识别，它会将文档中的文本更改为实际匹配的邮件合并字段名称。例如，如果有一个名为“project_date”的邮件合并字段，并且在 Word 文档中有文本“project_date”，则宏会将文本转换为实际的邮件合并字段“project_date”。

理想情况下，宏会对同时存在的所有邮件合并字段执行此操作。

以下是我制定所需代码的内容。

我在这里找到了这段代码 (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)，但它一次只会执行一个指定的邮件合并字段。

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

这是我自己录制的，但不知道如何用所需的合并字段搜索和替换文本。

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 code for inserting all merge fields 与您找到/记录的基本代码组合到一个文档中。插入合并字段被移动到在文档中搜索字段名称的函数中。我已将函数设置为返回字段插入的次数。

函数的棘手或特殊部分是在成功查找后设置范围以继续搜索。合并字段的端点仍在合并字段内，因此在折叠 Range 后需要行 oRng.MoveStart wdCharacter, 2。如果 Range 停留在该字段内，则会一次又一次地找到其中的合并字段名称……

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