在不知道架构 XPaths 的情况下自动将 Excel XmlMap 映射到 VBA 中的工作表

Automatically map an Excel XmlMap to a worksheet in VBA without knowing the schema XPaths

提问by Chris

I am building an Excel file that downloads from an API.

我正在构建一个从 API 下载的 Excel 文件。

It can automatically generate the XmlMap from the URL schema metadata. However I then need to map the XmlMap elements to ListObjects in order to pull the data and put on a worksheet.

它可以从 URL 架构元数据自动生成 XmlMap。但是，我需要将 XmlMap 元素映射到 ListObjects 以提取数据并放在工作表上。

The code to do this is range.Xpath.SetValue map xPathfor each item (from MSDN):

执行此操作的代码range.Xpath.SetValue map xPath适用于每个项目（来自MSDN）：

Sub CreateXMLList() 
    Dim mapContact As XmlMap 
    Dim strXPath As String 
    Dim lstContacts As ListObject 
    Dim objNewCol As ListColumn 

    ' Specify the schema map to use. 
    Set mapContact = ActiveWorkbook.XmlMaps("Contacts") 

    ' Create a new list. 
    Set lstContacts = ActiveSheet.ListObjects.Add 

    ' Specify the first element to map. 
    strXPath = "/Root/Person/FirstName" 
    ' Map the element. 
    lstContacts.ListColumns(1).XPath.SetValue mapContact, strXPath 

    ' Specify the second element to map. 
    strXPath = "/Root/Person/LastName" 
    ' Add a column to the list. 
    Set objNewCol = lstContacts.ListColumns.Add 
    ' Map the element. 
    objNewCol.XPath.SetValue mapContact, strXPath 

    strXPath = "/Root/Person/Address/Zip" 
    Set objNewCol = lstContacts.ListColumns.Add 
    objNewCol.XPath.SetValue mapContact, strXPath 
End Sub

Here's the schema output:

这是架构输出：

<?xml version="1.0" encoding="utf-8"?>
<xsd:schema xmlns:xsd="http://www.w3.org/2001/XMLSchema" >
    <xsd:element name="root" nillable="true" >
        <xsd:complexType>
            <xsd:sequence minOccurs="0">
                <xsd:element minOccurs="0" maxOccurs="unbounded" nillable="true" name="list-item" form="unqualified">
                    <xsd:complexType>
                        <xsd:sequence minOccurs="0">

                            <xsd:element name="data_source_organization"
                                minOccurs="0"
                                nillable="true"
                                type="xsd:string"
                                form="unqualified"
                            />

                            <xsd:element name="survey_name"
                                minOccurs="0"
                                nillable="true"
                                type="xsd:string"
                                form="unqualified"
                            />
                        </xsd:sequence>
                    </xsd:complexType>
                </xsd:element>
            </xsd:sequence>
        </xsd:complexType>
    </xsd:element>
</xsd:schema>

Here's the data (from which Excel automatically gets the schema and creates the XmlMap, if using the GUI):

这是数据（如果使用 GUI，Excel 会自动从中获取架构并创建 XmlMap）：

<root xsi:noNamespaceSchemaLocation="/api/domain/schema/?format=xml">
    <list-item>
        <data_source_organization>An org</data_source_organization>
        <survey_name>A Survey</survey_name>
    </list-item>
    <list-item>
        <data_source_organization>An org</data_source_organization>
        <survey_name>Another Survey</survey_name>
    </list-item>
</root>

However I don't want to specify the XPath strings - I want Excel to get everything from the schema metadata, just like it does if you use the GUI functionality (Data, Get External Data, From Other Sources, XML, paste a URL) - this automatically creates an XML map, creates a ListObject on the worksheet, maps every column in the source data, and grabs and displays the data. (If you record a macro doing this, it skips the mapping step.)

但是，我不想指定 XPath 字符串 - 我希望 Excel 从架构元数据中获取所有内容，就像使用 GUI 功能（数据、获取外部数据、来自其他来源、XML、粘贴 URL）一样- 这会自动创建一个 XML 映射，在工作表上创建一个 ListObject，映射源数据中的每一列，并抓取和显示数据。（如果您录制了一个这样做的宏，它会跳过映射步骤。）

• Can I point an XmlMap to a cell, range or ListObject?
• Can I iterate the XmlMap and retrieve every list-item XPath?
• Some other way?

• 我可以将 XmlMap 指向单元格、范围或 ListObject 吗？
• 我可以迭代 XmlMap 并检索每个列表项 XPath 吗？
• 其他方式？

To experiment/reproduce, save the above XML as files, then create a sub as follows:

要进行实验/复制，请将上述 XML 保存为文件，然后按如下方式创建子项：

Set currentMap = ActiveWorkbook.XmlMaps.Add("C:\path\to\schema.xml", "root")
currentMap.DataBinding.LoadSettings "path\to\data.xml"
' Do something to map the XmlMap elements to cells in the spreadsheet
' eg, objNewCol.XPath.SetValue currentMap, "root/data_source_organization"
' But some method that does not involve naming the Xml paths but iterates the schema
currentMap.DataBinding.Refresh

If the XmlMap is mapped to cells, those cells will populate with data.

如果 XmlMap 映射到单元格，这些单元格将填充数据。

回答by Parfait

Consider using Workbooks.OpenXMLmethod as your XML file is flat and simple with one-child level for easy tabular import:

考虑使用Workbooks.OpenXML方法，因为您的 XML 文件是扁平和简单的，具有单子级别，便于表格导入：

Sub ImportXML()   
     Workbooks.OpenXML "C:\Path\To\File.xml", , xlXmlLoadImportToList
End Sub

---

---

Now, if your XML is complex with nested child elements, consider building and running XSLT, the special-purpose language designed to transform XML files. Such transformations can be automated with the MSXMLlibrary, available as a VBA reference. Note: XSLT is not an XSD schema file but part of the extensible stylesheet family of which includes XPath.

现在，如果您的 XML 具有复杂的嵌套子元素，请考虑构建和运行XSLT，这是一种旨在转换 XML 文件的专用语言。可以使用MSXML库自动执行此类转换，该库可作为 VBA 参考使用。注意：XSLT 不是 XSD 模式文件，而是包含 XPath 的可扩展样式表系列的一部分。

Below XSLT removes the namespace from original XML. But script can be used to flatten nested, complex structures to flat, simple ones like your posted example.

XSLT 下面从原始 XML 中删除名称空间。但是脚本可用于将嵌套的复杂结构展平为平坦的简单结构，例如您发布的示例。

XSLT(save as .xsl file; removes any namespace and attributes from document)

XSLT （另存为 .xsl 文件；从文档中删除任何命名空间和属性）

<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
    <xsl:output method="xml" indent="yes"/>
    <xsl:strip-space elements="*"/>

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

VBA

VBA

Sub XSLTransformAndImport()
On Error GoTo ErrHandle
    ' SELECT Microsoft XML, v6 AS VBA REFERENCE
    Dim xmldoc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60

    ' LOAD XML AND XSL FILES
    xslDoc.async = False
    xmldoc.Load "C:\Path\To\Input.xml"
    xslDoc.async = False
    xslDoc.Load "C:\Path\To\XSLTScript.xsl"

    ' TRANSFORM XML
    xmldoc.transformNodeToObject xslDoc, newDoc
    newDoc.Save "C:\Path\To\Output.xml"

    ' IMPORT INTO WORKBOOK AS TABLE
    Workbooks.OpenXML "C:\Path\To\Output.xml", , xlXmlLoadImportToList

ExitHandle
    ' RELEASE RESOURCES
    Set xmldoc = Nothing: Set xslDoc = Nothing: Set newDoc = Nothing
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Err.Raise xslDoc.parseError.ErrorCode, , xslDoc.parseError.reason
    Resume ExitHandle    
End Sub

回答by jsotola

Here is a starting point for dynamically determining column names. It prints some of the info about each node in immediate window. Further work would be needed to extract the names of the columns in a meaningful way:

这是动态确定列名的起点。它在立即窗口中打印有关每个节点的一些信息。需要进一步的工作以有意义的方式提取列的名称：

Sub Create_XSD()

    Dim i As Integer

    For i = ActiveWorkbook.XmlMaps.Count To 1 Step -1    'Delete all XML maps - to establish clean test environment
        ActiveWorkbook.XmlMaps(i).Delete
    Next
    ActiveSheet.Cells.Clear

    Dim strMyXml As String
    strMyXml = "<BookInfo>" _
             & "<Book>" _
             & "<ISBN>Text</ISBN>" _
             & "<Title>Text</Title>" _
             & "<Author>Text</Author>" _
             & "<Quantity>999</Quantity>" _
             & "</Book>" _
             & "<Book></Book>" _
             & "</BookInfo>"

    Application.DisplayAlerts = False                      ' Turn off warning messages

    Dim myMap As XmlMap
    Set myMap = ThisWorkbook.XmlMaps.Add(strMyXml)         ' this creates text that could be saved in an XSD file

    ' try this one
'   Set myMap = ThisWorkbook.XmlMaps.Add("https://maps.googleapis.com/maps/api/geocode/xml?address=90210")

    Application.DisplayAlerts = True

    Dim myXSD As String
    myXSD = ThisWorkbook.XmlMaps(1).Schemas(1).xml         ' XSD text

    Debug.Print vbCrLf & String(50, "*") & vbCrLf
    Debug.Print myXSD & vbCrLf & String(50, "-") & vbCrLf

'    MsgBox myXSD

' ---------------------------------------------------------------
'    Dim node As IXMLDOMNode
'    Dim nList As IXMLDOMNodeList
'    Dim nSel As IXMLDOMSelection

    Dim xmlDoc As DOMDocument
    Set xmlDoc = New DOMDocument
    xmlDoc.LoadXML myXSD

    printElement xmlDoc.ChildNodes, 1              ' prints stuff in immediate window (press ctrl-G to view)
    Debug.Print vbCrLf & String(50, "*") & vbCrLf

'    Set node = xmlDoc.SelectSingleNode("xsd:schema")
'    Set nList = xmlDoc.SelectNodes("xsd:schema")

'    Set node = xmlDoc.SelectSingleNode("xsd:element")
'    Set nSel = xmlDoc.getElementsByTagName("xsd:element")
'    Set nList = xmlDoc.SelectSingleNode("xsd:schema").SelectNodes("xsd:element")

Stop   ' look at xml source in workbook

    myMap.Delete
    Set myMap = Nothing

End Sub
'

Sub printElement(L As IXMLDOMNodeList, lev As Integer)

    Dim cN As Object, i As Integer

    For Each cN In L
        Debug.Print vbCrLf & "level: " & lev;

        Debug.Print Tab(lev * 2 + 10); cN.tagName;           ' indent each level ( tab() measures from begining of line )
        If (cN.tagName = "xsd:element") Then
            For i = 1 To cN.Attributes.Length
                Debug.Print Tab(lev * 2 + 14); cN.Attributes(i - 1).Name & String(2, vbTab) & cN.Attributes(i - 1).Value
            Next i
        End If
        printElement cN.ChildNodes, lev + 1
    Next cN

End Sub
'

回答by jsotola

This code maps to a table, but it does not do it automatically. It does show the correct column headers:

此代码映射到一个表，但它不会自动执行此操作。它确实显示了正确的列标题：

Sub minimalXML()

    Dim i As Integer

    For i = ActiveWorkbook.XmlMaps.Count To 1 Step -1    'Delete all XML maps - to establish clean test environment
        ActiveWorkbook.XmlMaps(i).Delete
    Next
    ActiveSheet.Cells.Clear


    Dim lstContacts As ListObject
    Dim objNewCol As ListColumn
    Dim strXPath As String

    ActiveSheet.ListObjects.Add(xlSrcRange, Range("b5:b5"), , xlYes).Name = "myTable"

    Dim myMap As XmlMap
'   Set myMap = ActiveWorkbook.XmlMaps("Root_Map")
    Set myMap = ActiveWorkbook.XmlMaps.Add("C:\Users\js\Desktop\excelWork\Expenses.xsd", "Root")

    Debug.Print myMap.RootElementName
'   Debug.Print myMap.Schemas(1).xml

    myMap.AdjustColumnWidth = True
'   myMap.AppendOnImport = False

    Application.DisplayAlerts = False              ' hide warning about column width
    ActiveSheet.ListObjects("myTable").ListColumns(1).XPath.SetValue myMap, "/Root/EmployeeInfo/Name"
    ActiveSheet.ListObjects("myTable").ListColumns.Add.XPath.SetValue myMap, "/Root/EmployeeInfo/Code"
    ActiveSheet.ListObjects("myTable").ListColumns.Add.XPath.SetValue myMap, "/Root/ExpenseItem/Description"
    ActiveSheet.ListObjects("myTable").ListColumns.Add.XPath.SetValue myMap, "/Root/ExpenseItem/Amount"
    Application.DisplayAlerts = True

    ActiveSheet.ListObjects("myTable").HeaderRowRange.ClearContents    ' show headers from xsd file

'    myMap.DataBinding.ClearSettings      ' not sure if this is needed

'    myMap.DataBinding.LoadSettings "C:\Users\js\Desktop\excelWork\Expenses.xsd"
'    myMap.DataBinding.Refresh

    myMap.Import "C:\Users\js\Desktop\excelWork\Expenses.xsd"  ' shorter version of two lines before this


    ActiveWorkbook.XmlImport "C:\Users\js\Desktop\excelWork\Expenses.xml", myMap, True

'    ActiveSheet.XmlMapQuery("/Root/EmployeeInfo/Name").Select       ' refer to column by name


'    Debug.Print ActiveWorkbook.XmlMaps(1).WorkbookConnection.Ranges(1).Formula(1, 1)
'    Debug.Print ActiveWorkbook.XmlMaps(1).WorkbookConnection.Ranges(1).ListObject.QueryTable.CommandText
'    Debug.Print ActiveWorkbook.XmlMaps(1).WorkbookConnection.Ranges(1).ListObject.ListColumns.Count
'    Debug.Print ActiveWorkbook.XmlMaps(1).WorkbookConnection.Ranges(1).Areas.Count
'    Debug.Print ActiveWorkbook.XmlMaps(1).WorkbookConnection.Ranges(1).Cells.Count
'    Debug.Print ActiveWorkbook.XmlMaps(1).WorkbookConnection.Ranges(1).CurrentRegion.Count
'    Debug.Print ActiveWorkbook.XmlMaps(1).WorkbookConnection.Ranges(1).Areas.Count

Stop

    ActiveSheet.Cells.Delete
    myMap.Delete

    Set myMap = Nothing

End Sub
'

Expenses.xml

费用.xml

<?xml version="1.0" encoding="UTF-8" standalone="no" ?>
<Root>
  <EmployeeInfo>
    <Name>Jane Winston</Name>
    <Date>2001-01-01</Date>
    <Code>0001</Code>
  </EmployeeInfo>
  <ExpenseItem>
    <Date>2001-01-01</Date>
    <Description>Airfare</Description>
    <Amount>500.34</Amount>
  </ExpenseItem>
  <ExpenseItem>
    <Date>2001-01-01</Date>
    <Description>Hotel</Description>
    <Amount>200</Amount>
  </ExpenseItem>
</Root>

Expenses.xsd

费用.xsd

<?xml version="1.0" encoding="UTF-8" standalone="no" ?>
<xsd:schema xmlns:xsd="http://www.w3.org/2001/XMLSchema">
  <xsd:element name="Root">
    <xsd:complexType>
      <xsd:sequence>
        <xsd:element minOccurs="0" maxOccurs="1" name="EmployeeInfo">
          <xsd:complexType>
            <xsd:all>
              <xsd:element minOccurs="0" maxOccurs="1" name="Name" />
              <xsd:element minOccurs="0" maxOccurs="1" name="Date" />
              <xsd:element minOccurs="0" maxOccurs="1" name="Code" />
            </xsd:all>
          </xsd:complexType>
        </xsd:element>
        <xsd:element minOccurs="0" maxOccurs="unbounded" name="ExpenseItem">
          <xsd:complexType>
            <xsd:sequence>
              <xsd:element name="Date" type="xsd:date"/>
              <xsd:element name="Description" type="xsd:string"/>
              <xsd:element name="Amount" type="xsd:decimal" />
            </xsd:sequence>
          </xsd:complexType>
        </xsd:element>
      </xsd:sequence>
    </xsd:complexType>
  </xsd:element>
</xsd:schema>

Reference

参考

• Map XML elements to cells in an XML Map

• 将 XML 元素映射到 XML 映射中的单元格