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