VBA/Excel/Access/Word/XML/XmlMap
Associating XML Elements with Ranges
<source lang="vb">
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
</source>
Map Repeating Range
<source lang="vb">
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
</source>