HTML Code:
Sub AddContentControlAndMapToLocalXML()
Dim oCC As Word.ContentControl
Dim oCustomPart As Office.CustomXMLPart
Dim xmlPart As String
Dim doc As Word.Document
Set doc = ActiveDocument
Dim oRng As Word.Range
Dim strToFind As String
ClearXMLParts
xmlPart = "<?xml version='1.0' encoding='utf-8'?><Root><Item></Item></Root>"
Set oCustomPart = doc.CustomXMLParts.Add(xmlPart)
strToFind = "Text to find"
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = strToFind
.Wrap = wdFindStop
While .Execute
Set oCC = doc.ContentControls.Add(wdContentControlText, oRng)
oCC.XMLMapping.SetMapping "/Root/Item[1]", , oCustomPart
oCC.Range.Text = strToFind
oRng.Collapse wdCollapseEnd
Do While oRng.InRange(oCC.Range)
oRng.Move wdCharacter, 1
Loop
Wend
End With
End Sub
'Run ClearXMLParts prior to testing these examples.
Sub ClearXMLParts()
Dim i As Long
'MsgBox ActiveDocument.CustomXMLParts.Count
For i = ActiveDocument.CustomXMLParts.Count To 4 Step -1
ActiveDocument.CustomXMLParts(i).Delete
Next i
End Sub