Листинг 2.
Импорт XML-файла и преобразование его в таблицы Excel
Public Function ImportXML(xmlFileName As String, _
Optional objectPath As String = "*", _
Optional propertyPath As String = "*", _
Optional baseCell As Range = Nothing) As DOMDocument
' Экспорт данных из XML-файла
' 1. формируется DOMDocument объект (ImportXML)
' 2. По заданным параметрам данные из объекта
' переписываются в рабочую книгу
' ПАРАМЕТРЫ:
' xmlFileName - исходный XML-файла
' baseCell - исходный диапазон ячеек
' objectPath - строка запроса (queryString) на выборку узлов
' propertyPath - строка запроса (queryString) на выборку свойств
'
Dim xmlDoc As DOMDocument
Dim objectNodeList As IXMLDOMNodeList
Dim objectNode As IXMLDOMElement
Dim propertyNode As IXMLDOMElement
Dim baseRow&, baseCol&, rowIndex&, colIndex&
' координаты ячеек, куда будем записывать
If baseCell Is Nothing Then 'установка по умолчанию
Set baseCell = ActiveCell
End If
baseRow = baseCell.Row
baseCol = baseCell.Column
' создание DOMDocument объекта
Set xmlDoc = New DOMDocument
xmlDoc.Load xmlFileName ' загрузка XML-файла
' Перезапись данный в таблицу рабочей книги
' выбор узла
Set objectNodeList = xmlDoc.documentElement.selectNodes(objectPath)
If objectNodeList.Length > 0 Then
colIndex = 0
' формирование заголовка таблицы
Set objectNode = objectNodeList(0)
For Each propertyNode In _
objectNode.selectNodes(propertyPath)
ActiveSheet.Cells(baseRow, baseCol + colIndex).Value = _
propertyNode.nodeName
colIndex = colIndex + 1
Next
' выделение заголовка таблицы (первой строки) жирным шрифтом
ActiveSheet.Range(Cells(baseRow, _
baseCol), Cells(baseRow, baseCol + _
colIndex)).Font.Bold = True
' выборка всех остальных строк таблицы
rowIndex = 1
For Each objectNode In objectNodeList ' все узлы
colIndex = 0
For Each propertyNode In _
objectNode.selectNodes(propertyPath)
ActiveSheet.Cells(baseRow + rowIndex, _
baseCol + colIndex).Value = _
propertyNode.Text
colIndex = colIndex + 1
Next
rowIndex = rowIndex + 1
Next
End If
Set ImportXML = xmlDoc ' созданный DOMDocument
End Function