VBA/Excel/Access/Word/XML/XmlMap

Associating XML Elements with Ranges

 
Sub MapRanges() 
    Dim xmMap As XmlMap 
    Dim ws As Worksheet 
    Dim sPath As String 
    Dim loList As ListObject 
    Set ws = ThisWorkbook.Worksheets("Invoice") 
    Set xmMap = ThisWorkbook.XmlMaps("Invoice_Map") 
    Application.DisplayAlerts = False 
    sPath = "/Invoice/Customer/CustomerName" 
    MapRange ws.Range("CustomerName"), xmMap, sPath 
    Application.DisplayAlerts = True 
    Set xmMap = Nothing 
    Set ws = Nothing 
    Set loList = Nothing 
End Sub 
Function MapRange(rg As Range, xmMap As XmlMap, sPath As String) _ 
    As Boolean 
    On Error GoTo ErrHandler 
    If rg.XPath.Value = "" Then 
        rg.XPath.SetValue xmMap, sPath 
    Else 
        rg.XPath.Clear 
        rg.XPath.SetValue xmMap, sPath 
    End If 
    MapRange = True 
    Exit Function 
ErrHandler: 
    MapRange = True 
End Function

Map Repeating Range

 
Sub MapRanges() 
    Dim xmMap As XmlMap 
    Dim ws As Worksheet 
    Dim sPath As String 
    Dim loList As ListObject 
    Set ws = ThisWorkbook.Worksheets("Invoice") 
    Set xmMap = ThisWorkbook.XmlMaps("Invoice_Map") 
    Application.DisplayAlerts = False 
    Set loList = ws.ListObjects.Add(xlSrcRange, ws.Range("Qty").Resize(2, 4), , xlYes) 
    sPath = "/Invoice/Items/Item/Qty" 
    MapRepeatingRange loList.ListColumns(1), xmMap, sPath 
    Application.DisplayAlerts = True 
    Set xmMap = Nothing 
    Set ws = Nothing 
    Set loList = Nothing 
End Sub 
Function MapRepeatingRange(lcColumn As ListColumn, xmMap As XmlMap, _ 
    sPath As String) As Boolean 
    On Error GoTo ErrHandler 
    lcColumn.XPath.SetValue xmMap, sPath 
    Exit Function 
    MapRepeatingRange = True 
ErrHandler: 
    Debug.Print Err.Description 
    MapRepeatingRange = False 
End Function