Преобразование массива в XML (экспорт таблицы в файл XML)

Функция Array2XML формирует из исходной таблицы объект типа DOMDocument, который можно выгрузить в XML-файл одной строкой кода (метод Save)

Sub XMLExport()
    Dim Заголовок As Range, Данные As Range
    Set Заголовок = Range("a1:f1")
    Set Данные = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, Заголовок.Columns.Count)
 
    arrHeaders = Application.Transpose(Application.Transpose(Заголовок.Value))
    ПутьКФайлуXML = ThisWorkbook.Path & "\result.xml"
 
    ' формируем DOMDocument, и сохраняем XML в файл result.xml
    Array2XML(Данные.Value, arrHeaders, "Root").Save ПутьКФайлуXML
 
    If Err = 0 Then MsgBox "Создан XML файл" & vbNewLine & ПутьКФайлуXML, vbInformation, "Готово"
End Sub

Код функции Array2XML:

Function Array2XML(ByVal arrData, ByVal arrHeaders, ByVal strHeading$) As DOMDocument
    ' получает в качестве параметров:
    ' двумерный массив arrData с данными для выгрузки,
    ' одномерный массив arrHeaders, содержащий заголовки столбцов,
    ' и strHeading$ - XML-константу объекта
    Dim xmlDoc As DOMDocument, xmlFields As IXMLDOMElement, xmlField As IXMLDOMElement
    Set xmlDoc = CreateObject("Microsoft.XMLDOM")  ' создаём новый DOMDocument

    DataColumnsCount% = UBound(arrData, 2) - LBound(arrData, 2) + 1
    HeadersCount% = UBound(arrHeaders) - LBound(arrHeaders) + 1
    If DataColumnsCount% <> HeadersCount% Then MsgBox "Количество заголовков в массиве arrHeaders" & _
       "не соответствует количеству столбцов массива", vbCritical, "Ошибка создания XML": End
 
    xmlDoc.loadXML Replace("<" + strHeading + "/>", " ", "_")    ' записываем XML-константу объекта

    For i = LBound(arrData) To UBound(arrData)
        ' создание нового узла
        Set xmlFields = xmlDoc.documentElement.appendChild(xmlDoc.createElement("Row"))
 
        For j = LBound(arrHeaders) To UBound(arrHeaders)    ' добавление полей в узел
            Set xmlField = xmlFields.appendChild(xmlDoc.createElement(Replace(arrHeaders(j), " ", "_")))
            xmlField.Text = arrData(i, j + LBound(arrData, 2) - LBound(arrHeaders))
        Next j
    Next i
 
    Set Array2XML = xmlDoc
End Function

Функция нашла применение в программе выгрузки тарифов в XML

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Хотелось бы создавать Xml также из массива таблицы, верхние строки которой будут заголовками (подзаголовками)в несколько уровней?

Например:
1 Уровень <ФайлПФР>
..2 Уровень <ИмяФайла>...
..2 Уровень <ЗаголовокФайла>...
..2 Уровень <ПачкаВходящихДокументов.ДоставочнаяОрганизация="БАНК">
.....3 Уровень <ВХОДЯЩАЯ.ОПИСЬ>...
.....3 Уровень <СПИСОК.НА.ЗАЧИСЛЕНИЕ>
.......4 Уровень <НомерВпачке>2
.......4 Уровень <СведенияОполучателе>
..........5 Уровень <НомерВмассиве>1
..........5 Уровень <НомерВыплатногоДела>930158
..........5 Уровень <КодРайона>016-001-000
..........5 Уровень <СтраховойНомер>123-456-789.45
..........6 Уровень <ФИО>
.............7 Уровень <Фамилия>ИВАНОВ
.............7 Уровень <Имя>ИВАН
.............7 Уровень <Отчество>ИВАНОВИЧ

К сожалению в настоящий момент не имею материальной возможности оформлять заказы, поэтому приходится только советы спрашивать, перебирать чужие коды и по форумам попрошайничать :(

Здравствуйте, Valeri.
Сделать-то всё можно, - но, скорее всего, макрос надо писать «с нуля» (а не переделывать какой-то готовый код)

Оформляйте заказ на сайте, прикрепляйте примеры файлов (исходный файл, и пример результата), и подробно описывайте, что и как должно работать (что куда подставляться).

Подскажите пжт можно ли сделать иерархические заголовки вашим методом (в три уровня)
1 Уровень (Root)- Заголовок 1 →
2 Уровень - Подзаголовок 1, Подзаголовок 2, Подзаголовок 3 →
3 Уровень - Подподзаголок 1, Подподзаголок 2, Подподзаголок 3 и т.д. →
→ Ниже Элементы (массив)
Спасибо

Благодарю :) Работает!

Здравствуйте, Игорь.
1) option explicit не нужен
2) надо в Tools - References подключить библиотеки Microsoft HTML Object Library
и Microsoft XML version 3.0.

При использовании Вашей функции выходит ошибка user defined type not defined
Подскажите может что не так делаю
В модуле option explicit указал

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
        __   __  _        _               ___  
_ __ \ \ / / | | __ (_) __ __ ( _ )
| '__| \ V / | |/ / | | \ \ /\ / / / _ \
| | | | | < | | \ V V / | (_) |
|_| |_| |_|\_\ _/ | \_/\_/ \___/
|__/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.