Экспорт таблицы доступа в XML с помощью VBA

Question

У меня есть таблица доступа, которая была первоначально импортирована из XML. Когда я его экспортирую, у меня нет той же структуры XML, что и исходная таблица XML.

оригинальная импортирована таблица выглядит следующим образом:

<?xml version="1.0" standalone="true"?> 
<profiling> 
    <program> 
    <name>118CDSpro</name> 
    <p1on>1</p1on> 
    <p1tool>36</p1tool> 
    <p2on>OFF</p2on> 
    <cut>OFF</cut> 
    <rule>OFF</rule> 
    <desc>118 Clad DirectSet Profile</desc> 
    <pic>akv.bmp</pic> 
    <ten>dilec_F</ten> 
    </program> 
<profiling/> 

Это то, что я получаю в экспорте:

<?xml version="1.0" encoding="UTF-8"?> 
<dataroot generated="2016-06-27T12:16:29" xmlns:od="urn:schemas microsoft-com:officedata"> 
    <Profiling> 
    <name>Din_C92S_pro2</name> 
    <p1on>1</p1on> 
    <p1tool>40</p1tool> 
    <p2on>OFF</p2on> 
    <cut>OFF</cut> 
    <rule>OFF</rule> 
    <desc>Inswing Door Sash Profile 2 (Storm)</desc> 
    <ten>dilec_F</ten> 
    </Profiling> 
</dataroot> 

Я думаю, что проблема заключается в файл .xsl, но я новый к VBA и не уверены в том, как он используется.

Этот код должен быть очень точен в оригинальном формате.

Любые предложения были бы очень признательны.

Вариант 2 Код:

Sub ProfileXML2() 

    ' RAW XML EXPORT 
    Application.ExportXML acExportTable, "Profiling", "C:\MyData\Crafter 0610\Crafter\MACHINE\SCHEMAS\ProfileExport.xml" 


    ' TRANSFORM RAW XML (OPTION 2 - full XSLT processor) 
    Dim xmlDoc As Object, xslDoc As Object, newDoc As Object 

    Set xmlDoc = CreateObject("MSXML2.DOMDocument") 
    Set xslDoc = CreateObject("MSXML2.DOMDocument") 
    Set newDoc = CreateObject("MSXML2.DOMDocument") 

    ' LOAD XML AND XSL FILES 
    xmlDoc.Load "C:\MyData\Crafter 0610\Crafter\MACHINE\SCHEMAS\ProfileExport.xml" 
    xmlDoc.async = False 

    xslDoc.Load "C:\MyData\Crafter 0610\Crafter\MACHINE\SCHEMAS\ProfilingSchema.xsl" 
    xslDoc.async = False 

    ' TRANSFORM SOURCE TO FINAL 
    xmlDoc.transformNodeToObject xslDoc, newDoc 
    newDoc.Save "C:\MyData\Crafter 0610\Crafter\DATA\ProfilingTest.xml" 

    Set newDoc = Nothing 
    Set xslDoc = Nothing 
    Set xmlDoc = Nothing 

End Sub 

Answer 1

В настоящее время нет никаких проблем. MS Access не сохраняет импортированную структуру XML-файлов. Получаемый вами результат является стандартным шаблоном таблиц или вывода запроса в формате XML. Но так как ваши конечные потребности использования не могут удовлетворить этот необработанный вывод, подумайте об использовании XSLT, специального языка, предназначенного для преобразования XML-документов.

Вы можете либо запустить XSLT с помощью Application.TransformXML, либо с помощью библиотеки MSXML. Ниже кода VBA показаны оба варианта. Этот XSLT является специальным скриптом, так как первые два совпадения шаблонов удаляют пространство имен, urn: schemas microsoft-com: officedata, из выходных имен локальных элементов.

XSLT-скрипт(сохранить как .xsl быть загружен в VBA)

<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">  
    <xsl:output method="xml" version="1.0" encoding="UTF-8" indent="yes" /> 

    <xsl:template match="@*|node()"> 
    <xsl:element name="{local-name()}"> 
     <xsl:apply-templates select="@*|node()"/> 
    </xsl:element> 
    </xsl:template> 

    <xsl:template match="text()"> 
    <xsl:copy/> 
    </xsl:template> 

    <xsl:template match="dataroot">  
    <xsl:apply-templates select="Profiling"/>  
    </xsl:template> 

    <xsl:template match="Profiling"> 
    <profiling> 
     <program> 
     <xsl:apply-templates select="*"/> 
     </program> 
    </profiling> 
    </xsl:template> 

</xsl:stylesheet> 

VBA скрипт

Public Sub XMLHandle() 

    ' RAW XML EXPORT 
    Application.ExportXML acExportTable, "TableName", "C:\Path\To\Raw\Output.xml" 

    ' TRANSFORM RAW XML (OPTION 1 - limited XSLT method)  
    Application.TransformXML "C:\Path\To\Raw\Output.xml", _ 
          "C:\Path\To\XSLT\Transform.xsl", _ 
          "C:\Path\To\Final\Output.xml" 

    ' TRANSFORM RAW XML (OPTION 2 - full XSLT processor) 
    Dim xmlDoc As Object, xslDoc As Object, newDoc As Object 

    Set xmlDoc = CreateObject("MSXML2.DOMDocument") 
    Set xslDoc = CreateObject("MSXML2.DOMDocument") 
    Set newDoc = CreateObject("MSXML2.DOMDocument") 

    ' LOAD XML AND XSL FILES 
    xmlDoc.Load "C:\Path\To\Raw\Output.xml" 
    xmlDoc.async = False 

    xslDoc.Load "C:\Path\To\XSLT\Transform.xsl" 
    xslDoc.async = False 

    ' TRANSFORM SOURCE TO FINAL 
    xmlDoc.transformNodeToObject xslDoc, newDoc 
    newDoc.Save "C:\Path\To\Final\Output.xml" 

    Set newDoc = Nothing 
    Set xslDoc = Nothing 
    Set xmlDoc = Nothing 

End Sub 

Выход

<?xml version="1.0" encoding="UTF-8"?> 
<profiling> 
    <program> 
     <name>Din_C92S_pro2</name> 
     <p1on>1</p1on> 
     <p1tool>40</p1tool> 
     <p2on>OFF</p2on> 
     <cut>OFF</cut> 
     <rule>OFF</rule> 
     <desc>Inswing Door Sash Profile 2 (Storm)</desc> 
     <ten>dilec_F</ten> 
    </program> 
</profiling>