首页 文章

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

提问于
浏览 次
0

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

它可以从URL模式元数据中自动生成XmlMap . 但是，我需要将XmlMap元素映射到ListObjects，以便提取数据并放入工作表 .

执行此操作的代码是每个项目的 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

这是架构输出：

<?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>

这是数据（如果使用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>

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

  • 我可以将XmlMap指向单元格，范围或ListObject吗？

  • 我可以迭代XmlMap并检索每个列表项XPath吗？

  • 其他一些方式？

要试验/重现，将上述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

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

xml excel vba xpath

3 回答

  • 3

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

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

    Raw XML Import

    现在，如果您的XML与嵌套子元素很复杂，请考虑构建并运行XSLT，这是专门用于转换XML文件的专用语言 . 可以使用MSXML库自动进行此类转换，该库可用作VBA引用 . 注意：XSLT不是XSD架构文件，而是包含XPath的可扩展样式表系列的一部分 .

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

    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

    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

    Transformed XML Import

    回复于
  • 1

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

    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
'
    回复于
  • 0

    此代码映射到表，但它不会自动执行 . 它确实显示了正确的列 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 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

    <?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>

    参考

    回复于

相关问题