Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Экспорт из Excel в XML с помощью макроса на VBA, Выгрузка в XML
 
Здравствуйте, возникла необходимость конвертации данных из таблицы Excel в XML по схеме (схему приложил), перечитал много информации, понял что реально это сделать макросом, в интернете нашел пример макроса конвертации, попытался переделать макрос под выгрузку моих данных из Excel в XML чтоб выгрузка соответствовала моей схеме XML. Но что-то я видимо не совсем так делаю...
Помогите пожалуйста с макросом..
Код
Sub exportXML()

    'Путь для сохранения итогового XML
    xmlFile = ActiveWorkbook.Path & "\export.xml"
    
   
    'Номер строки начала таблицы с данными
    Dim data_row As Integer
    data_row = 2
    
    'Номер столбца "Номер"
    Dim numer_col As Integer
    numer_col = 7
    
    'Номер столбца "ДАТА"
    Dim date_col As Integer
    date_col = 2
    
    'Номер столбца "КОМПАНИЯ"
    Dim company_col As Integer
    company_col = 1
    
    'Номер столбца "От"
    Dim ot_metki_col As Integer
    ot_metki_col = 3


     'Номер столбца "До"
    Dim do_metki_col As Integer
    do_metki_col = 4
    
    
     'Номер столбца "Код"
    Dim kod_col As Integer
    kod_col = 5
    
    
     'Номер столбца "СТОИМОСТЬ"
    Dim price_col As Integer
    price_col = 6
    
    'Номер столбца "Объект"
    Dim objek_col As Integer
    objek_col = 8
    
    
    'Cоздание объекта XML
    Set xml = CreateObject("MSXML2.DOMDocument")
    'Добавление описания XML
    xml.appendChild xml.createProcessingInstruction("xml", "version='1.0' encoding='windows-1251'")
    
    'Добавление корневого элемента "lgt"
    Set lgt = xml.createElement("lgt")
    '''Добавление атрибута "name"
    ''''company.setAttribute "name", Cells(company_row, company_col)
    ''''xml.appendChild (company)
    
    'Цикл по строкам (пока не встретится строка с пустой ячейкой "Компания")
    Do While Not IsEmpty(Cells(data_row, company_col))
       'Вызов функции добавления данных //, num_col
        lgt.appendChild (createGsp(xml, Cells(data_row, ,)
                               Cells(data_row, numer_col), _
                               Cells(data_row, date_col), _
                               Cells(data_row, company_col), _
                               Cells(data_row, ot_metki_col), _
                               Cells(data_row, do_metki_col), _
                               Cells(data_row, kod_col), _
                               Cells(data_row, price_col), _
                               Cells(data_row, objek_col)))
        'Переход к следующей строке таблицы
        data_row = data_row + 1
    Loop
        
    'Выполнение XSL-преобразования для добавления отступов в XML
    Call transformXML(xml)
    
    'Сохранение файла (без выбора пути сохранения, удобно при отладке)
    'xml.Save xmlFile
    'MsgBox "Export complete!"

    'Сохранение файла (с выбором пути сохранения)
    xml.Save Application.GetSaveAsFilename("", "Файл экспорта (*.xml),", , "Введите имя файла", "Сохранить")

End Sub


'Функция добавления сотрудника компании(xml, "Номер", "Дата", "Компания", "От", "До", "Код", "СТОИМОСТЬ", "Объект") возвращает узел XML
Function createGsp(ByRef xml As Variant, ByVal num As Variant, ByVal name As Variant, _
                      ByVal profession As Variant, ByVal profit As Variant) As Variant

    'Создание элемента Gsp
    Set createGsp = xml.createElement("gsp")
    createGsp.setAttribute "num", num
    
    'Добавление в виде комментария "Профессия" (просто для примера)
    'createPerson.appendChild (xml.createComment(profession))

    'Создание элементов для столбцов "Номер", "Дата", "Компания", "От", "До", "Код", "СТОИМОСТЬ", "Объект"
    createGsp.appendChild(xml.createElement("numer")).Text = numer
    createGsp.appendChild(xml.createElement("date")).Text = Date
    createGsp.appendChild(xml.createElement("company")).Text = company
    createGsp.appendChild(xml.createElement("ot_metki")).Text = ot_metki
    createGsp.appendChild(xml.createElement("do_metki")).Text = do_metki
    createGsp.appendChild(xml.createElement("kod")).Text = kod
    createGsp.appendChild(xml.createElement("price")).Text = Price
    createGsp.appendChild(xml.createElement("objek")).Text = objek
    
End Function


'Процедура для придания XML читабельного вида (с отступами)
Sub transformXML(ByRef xml As Variant)

    'Cоздание объекта XSL
    Set xsl = CreateObject("MSXML2.DOMDocument")
    
    'Загрузка XSL из строки (не требует наличия отдельного XSL-файла)
    xsl.LoadXML ("<xsl:stylesheet version='1.0' xmlns:xsl='http://www.w3.org/1999/XSL/Transform'>" & vbCrLf & _
    "<xsl:output method='xml' version='1.0' encoding='windows-1251' indent='yes'/>" & vbCrLf & _
    "<xsl:template match='@*|node()'>" & vbCrLf & _
    "<xsl:copy>" & vbCrLf & _
    "<xsl:apply-templates select='@*|node()' />" & vbCrLf & _
    "</xsl:copy>" & vbCrLf & _
    "</xsl:template>" & vbCrLf & _
    "</xsl:stylesheet>")
    
    'Выполнение преобразования
    xml.transformNodeToObject xsl, xml

End Sub




 
Доброе время суток.
Несколько переделал. Метод ExportXML2
 
Огромное спасибо! Работает как и нужно было.
Данные в XLS файле подкорректировал чтоб номер был формата 000-000-000 00. Ещё можете подсказать возможно ли в выгрузке XML вместо табуляции перед тегами использовать пробелы? Вместо одного Tab - два пробела, вместо двух Tab - четыре пробела?

Код
Сейчас так:

<?xml version="1.0" encoding="windows-1251"?>
<lgt>
  <gsp>
    <numer>012-345-678 98</numer>
      <date>24.01.2018</date>
      <company>Компания 1</company>
      <ot_metki>Метка 1</ot_metki>
      <do_metki>Метка 2</do_metki>
      <kod>Y0087527</kod>
      <price>800</price>
      <objek>2123</objek>
   </gsp>
  <gsp>

Возможно ли так:

<?xml version="1.0" encoding="windows-1251"?>
<lgt>
  <gsp>
    <numer>012-345-678 98</numer>
    <date>24.01.2018</date>
    <company>Компания 1</company>
    <ot_metki>Метка 1</ot_metki>
    <do_metki>Метка 2</do_metki>
    <kod>Y0087527</kod>
    <price>800</price>
    <objek>2123</objek>
  </gsp>
<gsp>
 
Прикрепил файлы, т.к. в предыдущем сообщении забыл это сделать.
Изменено: llever - 26 фев 2019 14:09:42
 
Цитата
llever написал:
Вместо одного Tab - два пробела
Получаете текст xmlDoc.XML заменяете табуляцию на два пробела, грузите текст xmlDoc.loadXML
 
Большое спасибо за помощь!
 
Цитата
Андрей VG написал:
Метод ExportXML2
Здравствуйте! Очень помог этот метод, уже было почти адаптировал под свою задачу. Но не могу справиться с использованием пространства имён, причём в определённой иерархии - прикрепил результат, которого пытаюсь добиться.
Подскажите, пожалуйста, как это реализовать.
Страницы: 1
Читают тему (гостей: 1)
Наверх