MS Word VBA - 使用匹配的邮件合并字段替换文本

时间:2018-05-01 19:19:08

标签: ms-word word-vba mailmerge

我想在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 

1 个答案:

答案 0 :(得分:3)

此解决方案将the code for inserting all merge fields与您找到/录制的基本代码合并到一个文档中。插入合并字段将移动到搜索文档中字段名称的函数中。我已将函数设置为返回字段插入的次数。

功能的棘手或特殊部分是在成功查找后设置范围以继续搜索。合并字段的结束点仍在合并字段内,因此在折叠范围后需要行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
相关问题