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