Добавление схемы в файл xml при импорте данных из Excel - Мир MS Excel

Регистрация

Напомнить пароль

= Мир MS Excel/Добавление схемы в файл xml при импорте данных из Excel - Мир MS Excel

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Добавление схемы в файл xml при импорте данных из Excel (Макросы/Sub)

Добавление схемы в файл xml при импорте данных из Excel

Дата: Пятница, 07.12.2018, 16:05 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Добрый день.
Мне необходимо экспортировать данные с р/л Excel в <файл.xml> с предопределенной структурой. Макрос для экспорта самих данных у меня получился.
Однако, проблемой оказалось добавление в начало <файла.xml> схемы XML. Поиск по "И-Нету" успехом не увенчался...
Подскажите, как макросом дописать схему XML в итоговый файл?
Пример итогового <файла.xml> прилагаю, именно такой блок строк (<xs:schema ... </xs:schema>) надо автоматически формировать при создании файла .xml ...

К сообщению приложен файл: 3451626.xml (1.0 Kb)

Ответить

Дата: Пятница, 07.12.2018, 17:19 | Сообщение № 2

Группа: Друзья

Ранг: Ветеран

Сообщений: 947

Репутация: 323 ±

Замечаний: 0% ±

Excel 2010

Здравствуйте.

Цитата Sergik, 07.12.2018 в 16:05, в сообщении № 1 ()

Макрос для экспорта самих данных у меня получился

Где этот макрос, в нем я могу дописать часть кода для вставки схемы

Ответить

Дата: Пятница, 07.12.2018, 17:39 | Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

[vba]

Код

Sub Export()
  Dim I As Integer                          ' TMP
  Dim cRow As Integer                    ' current row
' -------------------------------------------------
  Sheets("Orders").Select
  xml_File = ActiveWorkbook.Path & "\Test.xml"
  Set xml_Obj = CreateObject("MSXML2.DOMDocument")
  xml_Obj.appendChild xml_Obj.createProcessingInstruction("xml", "version='1.0' standalone='yes'")
  Set Data_Set = xml_Obj.createElement("NewDataSet")
  xml_Obj.appendChild (Data_Set)
' -------------------------------------------------
' тут будет схема XML..?
' -------------------------------------------------
  cRow = 3
  Do While Not IsEmpty(Cells(cRow, 1))
' --------
    Set createHeader = xml_Obj.createElement("OrderHeader")
'   add
    createHeader.appendChild(xml_Obj.createElement("Id")).Text = "Test id"
    createHeader.appendChild(xml_Obj.createElement("Cl")).Text = "Test cl"
    Data_Set.appendChild createHeader
    cRow = cRow + 1
' --------
  Loop
' отступы
  SetShiftToXML xml_Obj
  xml_Obj.Save xml_File
' -------------------------------------------------
  MsgBox "Export complete!"
End Sub

Sub SetShiftToXML(ByRef xml As Variant)
' отступы
' -------------------------------------------------
    Set xsl = CreateObject("MSXML2.DOMDocument")

    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='UTF-8' 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

[/vba]

Ответить

Сообщение[vba]

Код

Sub Export()
  Dim I As Integer                          ' TMP
  Dim cRow As Integer                    ' current row
' -------------------------------------------------
  Sheets("Orders").Select
  xml_File = ActiveWorkbook.Path & "\Test.xml"
  Set xml_Obj = CreateObject("MSXML2.DOMDocument")
  xml_Obj.appendChild xml_Obj.createProcessingInstruction("xml", "version='1.0' standalone='yes'")
  Set Data_Set = xml_Obj.createElement("NewDataSet")
  xml_Obj.appendChild (Data_Set)
' -------------------------------------------------
' тут будет схема XML..?
' -------------------------------------------------
  cRow = 3
  Do While Not IsEmpty(Cells(cRow, 1))
' --------
    Set createHeader = xml_Obj.createElement("OrderHeader")
'   add
    createHeader.appendChild(xml_Obj.createElement("Id")).Text = "Test id"
    createHeader.appendChild(xml_Obj.createElement("Cl")).Text = "Test cl"
    Data_Set.appendChild createHeader
    cRow = cRow + 1
' --------
  Loop
' отступы
  SetShiftToXML xml_Obj
  xml_Obj.Save xml_File
' -------------------------------------------------
  MsgBox "Export complete!"
End Sub

Sub SetShiftToXML(ByRef xml As Variant)
' отступы
' -------------------------------------------------
    Set xsl = CreateObject("MSXML2.DOMDocument")

    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='UTF-8' 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

[/vba]

Автор - Sergik
Дата добавления - 07.12.2018 в 17:39

Дата: Пятница, 07.12.2018, 21:00 | Сообщение № 4

Группа: Друзья

Ранг: Ветеран

Сообщений: 947

Репутация: 323 ±

Замечаний: 0% ±

Excel 2010

Тогда так.

Сообщение отредактировал doober - Пятница, 07.12.2018, 21:00

Ответить

Дата: Понедельник, 10.12.2018, 17:00 | Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

doober,
в лоб не получается, система выдает ошибку: "Invalid procedure call or argument"
на строку:
xml.transformNodeToObject xsl, xml

Мы ожидаем, что процедура, добавляющая отступы, выгрузит в файл схему?

Ответить

Дата: Понедельник, 10.12.2018, 22:39 | Сообщение № 6

Группа: Друзья

Ранг: Ветеран

Сообщений: 947

Репутация: 323 ±

Замечаний: 0% ±

Excel 2010

Цитата Sergik, 10.12.2018 в 17:00, в сообщении № 5 ()

xml.transformNodeToObject xsl, xml

А где Вы увидели эту строку в моем коде?
Не обратил внимания и не убрал мусор в вашем коде

Цитата Sergik, 10.12.2018 в 17:00, в сообщении № 5 ()

xml.transformNodeToObject xsl, xml

А где Вы увидели эту строку в моем коде?
Не обратил внимания и не убрал мусор в вашем коде

Сообщение отредактировал doober - Понедельник, 10.12.2018, 22:40

Ответить

Сообщение

Цитата Sergik, 10.12.2018 в 17:00, в сообщении № 5 ()

xml.transformNodeToObject xsl, xml

А где Вы увидели эту строку в моем коде?
Не обратил внимания и не убрал мусор в вашем коде

Автор - doober
Дата добавления - 10.12.2018 в 22:39

Дата: Вторник, 11.12.2018, 15:24 | Сообщение № 7

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

doober,
спасибо за подсказку, почти получилось
Процедура теперь выглядит так:

[vba]

Код

Sub Export()
Dim I As Integer                          ' TMP
' -------------------------------------------------
  Sheets("Orders").Select
  xml_File = ActiveWorkbook.Path & "\Test.xml"
  Set xml_Obj = CreateObject("MSXML2.DOMDocument")
  xml_Obj.appendChild xml_Obj.createProcessingInstruction("xml", "version='1.0' standalone='yes'")
  Set Data_Set = xml_Obj.createElement("NewDataSet")
  xml_Obj.appendChild (Data_Set)
' -------------------------------------------------
' Shema
  Set xs = CreateObject("MSXML2.DOMDocument")
  xs.LoadXML ( _
    "<xs:schema id='NewDataSet' xmlns='' xmlns:xs='http://www.w3.org/2001/XMLSchema' xmlns:msdata='urn:schemas-microsoft-com:xml-msdata'>" & vbCrLf & _
     "<xs:element name='NewDataSet' msdata:IsDataSet='true' msdata:MainDataTable='OrderHeader' msdata:UseCurrentLocale='true'>" & vbCrLf & _
      "<xs:complexType>" & vbCrLf & _
       "<xs:choice minOccurs='0' maxOccurs='unbounded'>" & vbCrLf & _
        "<xs:element name='OrderHeader'>" & vbCrLf & _
         "<xs:complexType>" & vbCrLf & _
          "<xs:sequence>" & vbCrLf & _
           "<xs:element name='Id' type='xs:string' minOccurs='0' />" & vbCrLf & _
           "<xs:element name='Cl' type='xs:string' minOccurs='0' />" & vbCrLf & _
          "</xs:sequence>" & vbCrLf & _
         "</xs:complexType>" & vbCrLf & _
        "</xs:element>" & vbCrLf & _
       "</xs:choice>" & vbCrLf & _
      "</xs:complexType>" & vbCrLf & _
     "</xs:element>" & vbCrLf & _
    "</xs:schema>")
  Data_Set.appendChild (xs.FirstChild)
  Set xs = Nothing
' -------------------------------------------------
' Data test
  For I = 1 To 2
    Set createHeader = xml_Obj.createElement("OrderHeader")
    createHeader.appendChild(xml_Obj.createElement("Id")).Text = "Test id=" & Str(I)
    createHeader.appendChild(xml_Obj.createElement("Cl")).Text = "Test cl=" & Str(I)
    Data_Set.appendChild createHeader
  Next I
' -------------------------------------------------
' Shift
  Set xsl = CreateObject("MSXML2.DOMDocument")
    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='UTF-8' 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_Obj.transformNodeToObject xsl, xml_Obj
' -------------------------------------------------
  xml_Obj.Save xml_File
  MsgBox "Export complete!"
End Sub

[/vba]

Файл xml, генерируемый процедурой прилагаю. В нем осталась одна неточность.
вместо 4-х строк:
<xs:element name="Id" type="xs:string" minOccurs="0">
</xs:element>
<xs:element name="Cl" type="xs:string" minOccurs="0">
</xs:element>
надо сгенерить 2 строки:
<xs:element name="Id" type="xs:string" minOccurs="0" />
<xs:element name="Cl" type="xs:string" minOccurs="0" />
Подскажете, как это можно сделать?

doober,
спасибо за подсказку, почти получилось
Процедура теперь выглядит так:

[vba]

Код

Sub Export()
Dim I As Integer                          ' TMP
' -------------------------------------------------
  Sheets("Orders").Select
  xml_File = ActiveWorkbook.Path & "\Test.xml"
  Set xml_Obj = CreateObject("MSXML2.DOMDocument")
  xml_Obj.appendChild xml_Obj.createProcessingInstruction("xml", "version='1.0' standalone='yes'")
  Set Data_Set = xml_Obj.createElement("NewDataSet")
  xml_Obj.appendChild (Data_Set)
' -------------------------------------------------
' Shema
  Set xs = CreateObject("MSXML2.DOMDocument")
  xs.LoadXML ( _
    "<xs:schema id='NewDataSet' xmlns='' xmlns:xs='http://www.w3.org/2001/XMLSchema' xmlns:msdata='urn:schemas-microsoft-com:xml-msdata'>" & vbCrLf & _
     "<xs:element name='NewDataSet' msdata:IsDataSet='true' msdata:MainDataTable='OrderHeader' msdata:UseCurrentLocale='true'>" & vbCrLf & _
      "<xs:complexType>" & vbCrLf & _
       "<xs:choice minOccurs='0' maxOccurs='unbounded'>" & vbCrLf & _
        "<xs:element name='OrderHeader'>" & vbCrLf & _
         "<xs:complexType>" & vbCrLf & _
          "<xs:sequence>" & vbCrLf & _
           "<xs:element name='Id' type='xs:string' minOccurs='0' />" & vbCrLf & _
           "<xs:element name='Cl' type='xs:string' minOccurs='0' />" & vbCrLf & _
          "</xs:sequence>" & vbCrLf & _
         "</xs:complexType>" & vbCrLf & _
        "</xs:element>" & vbCrLf & _
       "</xs:choice>" & vbCrLf & _
      "</xs:complexType>" & vbCrLf & _
     "</xs:element>" & vbCrLf & _
    "</xs:schema>")
  Data_Set.appendChild (xs.FirstChild)
  Set xs = Nothing
' -------------------------------------------------
' Data test
  For I = 1 To 2
    Set createHeader = xml_Obj.createElement("OrderHeader")
    createHeader.appendChild(xml_Obj.createElement("Id")).Text = "Test id=" & Str(I)
    createHeader.appendChild(xml_Obj.createElement("Cl")).Text = "Test cl=" & Str(I)
    Data_Set.appendChild createHeader
  Next I
' -------------------------------------------------
' Shift
  Set xsl = CreateObject("MSXML2.DOMDocument")
    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='UTF-8' 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_Obj.transformNodeToObject xsl, xml_Obj
' -------------------------------------------------
  xml_Obj.Save xml_File
  MsgBox "Export complete!"
End Sub

[/vba]

Файл xml, генерируемый процедурой прилагаю. В нем осталась одна неточность.
вместо 4-х строк:
<xs:element name="Id" type="xs:string" minOccurs="0">
</xs:element>
<xs:element name="Cl" type="xs:string" minOccurs="0">
</xs:element>
надо сгенерить 2 строки:
<xs:element name="Id" type="xs:string" minOccurs="0" />
<xs:element name="Cl" type="xs:string" minOccurs="0" />
Подскажете, как это можно сделать?Sergik

К сообщению приложен файл: Test.xml (0.9 Kb)

Ответить

Сообщениеdoober,
спасибо за подсказку, почти получилось
Процедура теперь выглядит так:

[vba]

Код

Sub Export()
Dim I As Integer                          ' TMP
' -------------------------------------------------
  Sheets("Orders").Select
  xml_File = ActiveWorkbook.Path & "\Test.xml"
  Set xml_Obj = CreateObject("MSXML2.DOMDocument")
  xml_Obj.appendChild xml_Obj.createProcessingInstruction("xml", "version='1.0' standalone='yes'")
  Set Data_Set = xml_Obj.createElement("NewDataSet")
  xml_Obj.appendChild (Data_Set)
' -------------------------------------------------
' Shema
  Set xs = CreateObject("MSXML2.DOMDocument")
  xs.LoadXML ( _
    "<xs:schema id='NewDataSet' xmlns='' xmlns:xs='http://www.w3.org/2001/XMLSchema' xmlns:msdata='urn:schemas-microsoft-com:xml-msdata'>" & vbCrLf & _
     "<xs:element name='NewDataSet' msdata:IsDataSet='true' msdata:MainDataTable='OrderHeader' msdata:UseCurrentLocale='true'>" & vbCrLf & _
      "<xs:complexType>" & vbCrLf & _
       "<xs:choice minOccurs='0' maxOccurs='unbounded'>" & vbCrLf & _
        "<xs:element name='OrderHeader'>" & vbCrLf & _
         "<xs:complexType>" & vbCrLf & _
          "<xs:sequence>" & vbCrLf & _
           "<xs:element name='Id' type='xs:string' minOccurs='0' />" & vbCrLf & _
           "<xs:element name='Cl' type='xs:string' minOccurs='0' />" & vbCrLf & _
          "</xs:sequence>" & vbCrLf & _
         "</xs:complexType>" & vbCrLf & _
        "</xs:element>" & vbCrLf & _
       "</xs:choice>" & vbCrLf & _
      "</xs:complexType>" & vbCrLf & _
     "</xs:element>" & vbCrLf & _
    "</xs:schema>")
  Data_Set.appendChild (xs.FirstChild)
  Set xs = Nothing
' -------------------------------------------------
' Data test
  For I = 1 To 2
    Set createHeader = xml_Obj.createElement("OrderHeader")
    createHeader.appendChild(xml_Obj.createElement("Id")).Text = "Test id=" & Str(I)
    createHeader.appendChild(xml_Obj.createElement("Cl")).Text = "Test cl=" & Str(I)
    Data_Set.appendChild createHeader
  Next I
' -------------------------------------------------
' Shift
  Set xsl = CreateObject("MSXML2.DOMDocument")
    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='UTF-8' 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_Obj.transformNodeToObject xsl, xml_Obj
' -------------------------------------------------
  xml_Obj.Save xml_File
  MsgBox "Export complete!"
End Sub

[/vba]

Файл xml, генерируемый процедурой прилагаю. В нем осталась одна неточность.
вместо 4-х строк:
<xs:element name="Id" type="xs:string" minOccurs="0">
</xs:element>
<xs:element name="Cl" type="xs:string" minOccurs="0">
</xs:element>
надо сгенерить 2 строки:
<xs:element name="Id" type="xs:string" minOccurs="0" />
<xs:element name="Cl" type="xs:string" minOccurs="0" />
Подскажете, как это можно сделать?

Автор - Sergik
Дата добавления - 11.12.2018 в 15:24

Дата: Вторник, 11.12.2018, 17:24 | Сообщение № 8

Группа: Друзья

Ранг: Ветеран

Сообщений: 947

Репутация: 323 ±

Замечаний: 0% ±

Excel 2010

Вам шашечки или ехать?
Уберите форматирование по стилю и будет счастье.

Ответить

Дата: Среда, 12.12.2018, 08:58 | Сообщение № 9

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

doober,
мне и шашечки и ехать, и про форматирование я уже понял
однако, если либо-либо, то мне интересно, как сгенерили тот xml файл, что я выложил самым первым: 3451626.xml - в нем и структура и формат вполне себе уживаются
Что скажете?

Ответить

Дата: Среда, 12.12.2018, 12:49 | Сообщение № 10

Группа: Друзья

Ранг: Ветеран

Сообщений: 947

Репутация: 323 ±

Замечаний: 0% ±

Excel 2010

Попробуйте поиграться с отступами
[vba]

Код

Set BlankNode = xml_Obj.createTextNode("elementBlank")
BlankNode.Text = vbNewLine & " "
createHeader.appendChild BlankNode

[/vba]

Ответить

Дата: Пятница, 14.12.2018, 17:12 | Сообщение № 11

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

doober,
в итоге удалось получить <файл.ml> требуемой структуры, хотя бы и в "ручном" режиме...
спасибо за помощь!

Ответить

Дата: Вторник, 18.12.2018, 10:29 | Сообщение № 12

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 989 ±

Замечаний: 0% ±

Excel 2007,2010,2013

Если мне не изменяет память, то с помощью xslt можно и данные из excel/word 2007+ ввытянуть, и xsd в выходной xml впихнуть. Надо вспомнить где и как, по-моему, делал пподобное в altova mapforce

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Вторник, 18.12.2018, 10:32

Ответить

Дата: Вторник, 18.12.2018, 12:36 | Сообщение № 13

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

krosav4ig,
мне будет интересно рассмотреть альтернативный (существующему у меня) вариант выгрузки...

сможете припомнить?

Ответить

Дата: Среда, 19.12.2018, 23:54 | Сообщение № 14

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 989 ±

Замечаний: 0% ±

Excel 2007,2010,2013

Вспомнить-то вспомнилось, но чтоб пример сделать все времени не хватает, думаю завтро вечерком дойдут до этого руки

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Ответить

Дата: Четверг, 20.12.2018, 08:10 | Сообщение № 15

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

krosav4ig,
будет здорово, если получится...

Ответить

Дата: Четверг, 20.12.2018, 23:48 | Сообщение № 16

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 989 ±

Замечаний: 0% ±

Excel 2007,2010,2013

Для начала нужно провести махинацию с xsd - добавить [vba]

Код

<xs:import namespace="http://www.w3.org/2001/XMLSchema"/>

[/vba] и в том месте, где должна отображаться схема прописать [vba]

Код

<xs:element ref="xs:schema"/>

[/vba] это нужно для корректной разметки с использованием этой схемы (для трансформации эти декларации в xsd не нужны).
Состряпал для примера проект в altova mapforce. Из проекта сгенерировал xslt шаблон. Входным файлом для трансформации служит xsd файл, путь к excel файлу передается через параметр SourceFilePath, папка для сохранения выходного xml файла передается через параметр DestFolder (по умолчанию=папке из SourceFilePath) и имя выходного xml файла передается через параметр DestFile (по умолчанию=имени файла из SourceFilePath). Текст, передаваемый в параметр должен быть заключен в одинарные кавычки.
для трансформации используется бесплатный XSLT процессор ALTOVAXML 2013 после установки нужно добавить папку, в которую он установлен в переменную среды Path
непосредственно для трансформации нужны только исходный xslx, xsd схема и xslt шаблон (в данном случае 3 файла)
сделал 2 варианта обертки - bat[vba]

Код

cd /d .
AltovaXML -xslt2 xsl\main.xslt -in xsd\test1.xsd -param SourceFilePath='%~dp0src\test.xlsx'
pause

[/vba]и vbs[vba]

Код

Dim sFolder
sFolder = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
With CreateObject("AltovaXML.Application").XSLT2
    .InputXMLFileName = sFolder & "xsd\test1.xsd"
    .XSLFileName = sFolder & "xsl\main.xslt"
    .AddExternalParameter "SourceFilePath", "'" & sFolder & "src\test.xlsx'"
    .AddExternalParameter "DestFolder", "'" & sFolder & "'"
    .AddExternalParameter "DestFIle", "'test1.xml'"
    .Execute ""
End With

[/vba]
вместо InputXMLFileName можно использовать InputXMLFromText
[vba]

Код

Dim sFolder
sFolder = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
With CreateObject("AltovaXML.Application").XSLT2
    .InputXMLFromText = "<xs:schema id='NewDataSet' xmlns='' xmlns:xs='http://www.w3.org/2001/XMLSchema' xmlns:msdata='urn:schemas-microsoft-com:xml-msdata'>" & vbCrLf & _
    "<xs:element name='NewDataSet' msdata:IsDataSet='true' msdata:MainDataTable='OrderHeader' msdata:UseCurrentLocale='true'>" & vbCrLf & _
    "<xs:complexType>" & vbCrLf & _
    "<xs:choice minOccurs='0' maxOccurs='unbounded'>" & vbCrLf & _
        "<xs:element name='OrderHeader'>" & vbCrLf & _
        "<xs:complexType>" & vbCrLf & _
        "<xs:sequence>" & vbCrLf & _
        "<xs:element name='Id' type='xs:string' minOccurs='0' />" & vbCrLf & _
        "<xs:element name='Cl' type='xs:string' minOccurs='0' />" & vbCrLf & _
        "</xs:sequence>" & vbCrLf & _
        "</xs:complexType>" & vbCrLf & _
        "</xs:element>" & vbCrLf & _
    "</xs:choice>" & vbCrLf & _
    "</xs:complexType>" & vbCrLf & _
    "</xs:element>" & vbCrLf & _
    "</xs:schema>"
    .XSLFileName = sFolder & "xsl\main.xslt"
    .AddExternalParameter "SourceFilePath", "'" & sFolder & "src\test.xlsx'"
    .AddExternalParameter "DestFolder", "'" & sFolder & "'"
    .AddExternalParameter "DestFIle", "'test1.xml'"
    .Execute ""
End With

[/vba]
для раннего связывания в vba в папке с установленном ALTOVAXML есть файл AltovaXMLLib.tlb

Для начала нужно провести махинацию с xsd - добавить [vba]

Код

<xs:import namespace="http://www.w3.org/2001/XMLSchema"/>

[/vba] и в том месте, где должна отображаться схема прописать [vba]

Код

<xs:element ref="xs:schema"/>

[/vba] это нужно для корректной разметки с использованием этой схемы (для трансформации эти декларации в xsd не нужны).
Состряпал для примера проект в altova mapforce. Из проекта сгенерировал xslt шаблон. Входным файлом для трансформации служит xsd файл, путь к excel файлу передается через параметр SourceFilePath, папка для сохранения выходного xml файла передается через параметр DestFolder (по умолчанию=папке из SourceFilePath) и имя выходного xml файла передается через параметр DestFile (по умолчанию=имени файла из SourceFilePath). Текст, передаваемый в параметр должен быть заключен в одинарные кавычки.
для трансформации используется бесплатный XSLT процессор ALTOVAXML 2013 после установки нужно добавить папку, в которую он установлен в переменную среды Path
непосредственно для трансформации нужны только исходный xslx, xsd схема и xslt шаблон (в данном случае 3 файла)
сделал 2 варианта обертки - bat[vba]

Код

cd /d .
AltovaXML -xslt2 xsl\main.xslt -in xsd\test1.xsd -param SourceFilePath='%~dp0src\test.xlsx'
pause

[/vba]и vbs[vba]

Код

Dim sFolder
sFolder = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
With CreateObject("AltovaXML.Application").XSLT2
    .InputXMLFileName = sFolder & "xsd\test1.xsd"
    .XSLFileName = sFolder & "xsl\main.xslt"
    .AddExternalParameter "SourceFilePath", "'" & sFolder & "src\test.xlsx'"
    .AddExternalParameter "DestFolder", "'" & sFolder & "'"
    .AddExternalParameter "DestFIle", "'test1.xml'"
    .Execute ""
End With

[/vba]
вместо InputXMLFileName можно использовать InputXMLFromText
[vba]

Код

Dim sFolder
sFolder = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
With CreateObject("AltovaXML.Application").XSLT2
    .InputXMLFromText = "<xs:schema id='NewDataSet' xmlns='' xmlns:xs='http://www.w3.org/2001/XMLSchema' xmlns:msdata='urn:schemas-microsoft-com:xml-msdata'>" & vbCrLf & _
    "<xs:element name='NewDataSet' msdata:IsDataSet='true' msdata:MainDataTable='OrderHeader' msdata:UseCurrentLocale='true'>" & vbCrLf & _
    "<xs:complexType>" & vbCrLf & _
    "<xs:choice minOccurs='0' maxOccurs='unbounded'>" & vbCrLf & _
        "<xs:element name='OrderHeader'>" & vbCrLf & _
        "<xs:complexType>" & vbCrLf & _
        "<xs:sequence>" & vbCrLf & _
        "<xs:element name='Id' type='xs:string' minOccurs='0' />" & vbCrLf & _
        "<xs:element name='Cl' type='xs:string' minOccurs='0' />" & vbCrLf & _
        "</xs:sequence>" & vbCrLf & _
        "</xs:complexType>" & vbCrLf & _
        "</xs:element>" & vbCrLf & _
    "</xs:choice>" & vbCrLf & _
    "</xs:complexType>" & vbCrLf & _
    "</xs:element>" & vbCrLf & _
    "</xs:schema>"
    .XSLFileName = sFolder & "xsl\main.xslt"
    .AddExternalParameter "SourceFilePath", "'" & sFolder & "src\test.xlsx'"
    .AddExternalParameter "DestFolder", "'" & sFolder & "'"
    .AddExternalParameter "DestFIle", "'test1.xml'"
    .Execute ""
End With

[/vba]
для раннего связывания в vba в папке с установленном ALTOVAXML есть файл AltovaXMLLib.tlbkrosav4ig

К сообщению приложен файл: testprj.zip (20.3 Kb)

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Пятница, 21.12.2018, 00:16

Ответить

СообщениеДля начала нужно провести махинацию с xsd - добавить [vba]

Код

<xs:import namespace="http://www.w3.org/2001/XMLSchema"/>

[/vba] и в том месте, где должна отображаться схема прописать [vba]

Код

<xs:element ref="xs:schema"/>

[/vba] это нужно для корректной разметки с использованием этой схемы (для трансформации эти декларации в xsd не нужны).
Состряпал для примера проект в altova mapforce. Из проекта сгенерировал xslt шаблон. Входным файлом для трансформации служит xsd файл, путь к excel файлу передается через параметр SourceFilePath, папка для сохранения выходного xml файла передается через параметр DestFolder (по умолчанию=папке из SourceFilePath) и имя выходного xml файла передается через параметр DestFile (по умолчанию=имени файла из SourceFilePath). Текст, передаваемый в параметр должен быть заключен в одинарные кавычки.
для трансформации используется бесплатный XSLT процессор ALTOVAXML 2013 после установки нужно добавить папку, в которую он установлен в переменную среды Path
непосредственно для трансформации нужны только исходный xslx, xsd схема и xslt шаблон (в данном случае 3 файла)
сделал 2 варианта обертки - bat[vba]

Код

cd /d .
AltovaXML -xslt2 xsl\main.xslt -in xsd\test1.xsd -param SourceFilePath='%~dp0src\test.xlsx'
pause

[/vba]и vbs[vba]

Код

Dim sFolder
sFolder = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
With CreateObject("AltovaXML.Application").XSLT2
    .InputXMLFileName = sFolder & "xsd\test1.xsd"
    .XSLFileName = sFolder & "xsl\main.xslt"
    .AddExternalParameter "SourceFilePath", "'" & sFolder & "src\test.xlsx'"
    .AddExternalParameter "DestFolder", "'" & sFolder & "'"
    .AddExternalParameter "DestFIle", "'test1.xml'"
    .Execute ""
End With

[/vba]
вместо InputXMLFileName можно использовать InputXMLFromText
[vba]

Код

Dim sFolder
sFolder = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
With CreateObject("AltovaXML.Application").XSLT2
    .InputXMLFromText = "<xs:schema id='NewDataSet' xmlns='' xmlns:xs='http://www.w3.org/2001/XMLSchema' xmlns:msdata='urn:schemas-microsoft-com:xml-msdata'>" & vbCrLf & _
    "<xs:element name='NewDataSet' msdata:IsDataSet='true' msdata:MainDataTable='OrderHeader' msdata:UseCurrentLocale='true'>" & vbCrLf & _
    "<xs:complexType>" & vbCrLf & _
    "<xs:choice minOccurs='0' maxOccurs='unbounded'>" & vbCrLf & _
        "<xs:element name='OrderHeader'>" & vbCrLf & _
        "<xs:complexType>" & vbCrLf & _
        "<xs:sequence>" & vbCrLf & _
        "<xs:element name='Id' type='xs:string' minOccurs='0' />" & vbCrLf & _
        "<xs:element name='Cl' type='xs:string' minOccurs='0' />" & vbCrLf & _
        "</xs:sequence>" & vbCrLf & _
        "</xs:complexType>" & vbCrLf & _
        "</xs:element>" & vbCrLf & _
    "</xs:choice>" & vbCrLf & _
    "</xs:complexType>" & vbCrLf & _
    "</xs:element>" & vbCrLf & _
    "</xs:schema>"
    .XSLFileName = sFolder & "xsl\main.xslt"
    .AddExternalParameter "SourceFilePath", "'" & sFolder & "src\test.xlsx'"
    .AddExternalParameter "DestFolder", "'" & sFolder & "'"
    .AddExternalParameter "DestFIle", "'test1.xml'"
    .Execute ""
End With

[/vba]
для раннего связывания в vba в папке с установленном ALTOVAXML есть файл AltovaXMLLib.tlb

Автор - krosav4ig
Дата добавления - 20.12.2018 в 23:48

Дата: Пятница, 21.12.2018, 12:41 | Сообщение № 17

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

krosav4ig,
спасибо, обязательно посмотрю, правда только в пн., раньше не успею
напишу по результату...

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Добавление схемы в файл xml при импорте данных из Excel (Макросы/Sub)

Страница 1 из 1
1

© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!