Sub MapCCs()
Dim oCC As Word.ContentControl
Dim oCustomPart As Office.CustomXMLPart
Dim oDoc As Word.Document
Dim lngIndex As Long
Dim oNode As CustomXMLNode
  Set oDoc = ActiveDocument
  ClearXMLParts
  Set oCustomPart = oDoc.CustomXMLParts.Add("<?xml version='1.0' encoding='utf-8'?><Root_Node></Root_Node>")
  For lngIndex = 1 To oDoc.ContentControls.Count
    Set oCC = oDoc.ContentControls(lngIndex)
    Select Case oCC.Title
      Case "Name"
        Set oNode = oCustomPart.SelectSingleNode("/Name")
        If oNode Is Nothing Then
          oCustomPart.AddNode oCustomPart.SelectSingleNode("/Root_Node"), "Name"
        End If
        
        oCC.XMLMapping.SetMapping "/Root_Node/Name[1]", , oCustomPart
      Case "Address"
        Set oNode = oCustomPart.SelectSingleNode("/Address")
        If oNode Is Nothing Then
          oCustomPart.AddNode oCustomPart.SelectSingleNode("/Root_Node"), "Address"
        End If
       
        oCC.XMLMapping.SetMapping "/Root_Node/Address[1]", , oCustomPart
      Case "Age"
        Set oNode = oCustomPart.SelectSingleNode("/Age")
        If oNode Is Nothing Then
          oCustomPart.AddNode oCustomPart.SelectSingleNode("/Root_Node"), "Age"
        End If
        oCC.XMLMapping.SetMapping "/Root_Node/Age[1]", , oCustomPart
    End Select
  Next lngIndex
End Sub
'Run ClearXMLParts prior to testing these examples.
Sub ClearXMLParts()
Dim lngIndex As Long
'MsgBox ActiveDocument.CustomXMLParts.Count
For lngIndex = ActiveDocument.CustomXMLParts.Count To 4 Step -1
  ActiveDocument.CustomXMLParts(lngIndex).Delete
Next lngIndex
End Sub