将XML文档中的数据parsing到Excel工作表

<?xml version="1.0" encoding="UTF-8"?> <xa:MeContext id="ABCe0552553"> <xa:Data id="ABCe05525531" /> <xa:Data id="1" /> <CustID>Cust1234</CustID> <Name>Smith</Name> <City>New York</City> <Orders> <order Orderid="101"> <Product>MP3 Player</Product> </order> <order Orderid="102"> <Product>Radio</Product> </order> </Orders> </xa:MeContext> 

这个格式良好的XML文档使用MS VBA代码提供给Excel 2007。 我成功地使用DOMDocument和IXMLDOMElement来导入名称，城市和产品。
但是， xa:MeContext id ， vsData1 id ， VsData2 id ， CustID和order Orderid编号不会导出到Excel工作表。

每个Excel行都包含以下标头，其中包含从XML文档填充的数据：

 MeContextID--vsData1--VsData2--CustID--Name--City--OrderID--Product--OrderID--Product 

Answer 1

以下是输出您所需字段的两种方法。 请注意，您发布的XML不包含名称空间“xa：”的标题定义，因此不是完全形成的XML。 我已经在示例中删除了它们，所以MSXML2.DOMDocument不会抛出parsing错误。

 Option Explicit Sub XMLMethod() Dim XMLString As String Dim XMLDoc As Object Dim boolValue As Boolean Dim xmlDocEl As Object Dim xMeContext As Object Dim xChild As Object Dim xorder As Object XMLString = Sheet1.Range("A1").Value 'Remove xa: in this example 'reason : "Reference to undeclared namespace prefix: 'xa'." 'Shouldn't need to do this if full XML is well formed containing correct namespace XMLString = Replace(XMLString, "xa:", vbNullString) Set XMLDoc = CreateObject("MSXML2.DOMDocument") 'XMLDoc.setProperty "SelectionNamespaces", "xa:" 'XMLDoc.Load = "C:\Users\ooo\Desktop\test.xml" 'load from file boolValue = XMLDoc.LoadXML(XMLString) 'load from string Set xmlDocEl = XMLDoc.DocumentElement Set xMeContext = xmlDocEl.SelectSingleNode("//MeContext") Debug.Print Split(xMeContext.XML, """")(1) For Each xChild In xmlDocEl.ChildNodes If xChild.NodeName = "Orders" Then For Each xorder In xChild.ChildNodes Debug.Print Split(xorder.XML, """")(1) Debug.Print xorder.Text Next xorder ElseIf xChild.Text = "" Then Debug.Print Split(xChild.XML, """")(1) Else Debug.Print xChild.Text End If Next xChild 'Output: 'ABCe0552553 'ABCe05525531 '1 'Cust1234 'Smith 'New York '101 'MP3 Player '102 'Radio End Sub 

下面是使用正则expression式，如果XML每次都固定在您的示例中，那么它就是非常有用的。 一般情况下，build议不要对XML进行parsing，除非您希望提高可靠性。

 Option Explicit Sub RegexMethod() Dim XMLString As String Dim oRegex As Object Dim regexArr As Object Dim rItem As Object 'Assumes Sheet1.Range("A1").Value holds example XMLString XMLString = Sheet1.Range("A1").Value Set oRegex = CreateObject("vbscript.regexp") With oRegex .Global = True .Pattern = "(id=""|>)(.+?)(""|</)" Set regexArr = .Execute(XMLString) 'No lookbehind so replace unwanted chars .Pattern = "(id=""|>|""|</)" For Each rItem In regexArr 'Change Debug.Print to fill an array to write to Excel Debug.Print .Replace(rItem, vbNullString) Next rItem End With 'Output: 'ABCe0552553 'ABCe05525531 '1 'Cust1234 'Smith 'New York '101 'MP3 Player '102 'Radio End Sub 

编辑：轻微更新输出到arrays写入范围

 Option Explicit Sub RegexMethod() Dim XMLString As String Dim oRegex As Object Dim regexArr As Object Dim rItem As Object Dim writeArray(1 To 1, 1 To 10) As Variant Dim col As Long 'Assumes Sheet1.Range("A1").Value holds example XMLString XMLString = Sheet1.Range("A1").Value Set oRegex = CreateObject("vbscript.regexp") With oRegex .Global = True .Pattern = "(id=""|>)(.+?)(""|</)" Set regexArr = .Execute(XMLString) 'No lookbehind so replace unwanted chars .Pattern = "(id=""|>|""|</)" For Each rItem In regexArr 'Change Debug.Print to fill an array to write to Excel Debug.Print .Replace(rItem, vbNullString) col = col + 1 writeArray(1, col) = .Replace(rItem, vbNullString) Next rItem End With Sheet1.Range("A5:J5").Value = writeArray End Sub Sub XMLMethod() Dim XMLString As String Dim XMLDoc As Object Dim boolValue As Boolean Dim xmlDocEl As Object Dim xMeContext As Object Dim xChild As Object Dim xorder As Object Dim writeArray(1 To 1, 1 To 10) As Variant Dim col As Long XMLString = Sheet1.Range("A1").Value 'Remove xa: in this example 'reason : "Reference to undeclared namespace prefix: 'xa'." 'Shouldn't need to do this if full XML is well formed XMLString = Replace(XMLString, "xa:", vbNullString) Set XMLDoc = CreateObject("MSXML2.DOMDocument") 'XMLDoc.setProperty "SelectionNamespaces", "xa:" 'XMLDoc.Load = "C:\Users\ooo\Desktop\test.xml" 'load from file boolValue = XMLDoc.LoadXML(XMLString) 'load from string Set xmlDocEl = XMLDoc.DocumentElement Set xMeContext = xmlDocEl.SelectSingleNode("//MeContext") 'Debug.Print Split(xMeContext.XML, """")(1) col = col + 1 writeArray(1, col) = Split(xMeContext.XML, """")(1) For Each xChild In xmlDocEl.ChildNodes If xChild.NodeName = "Orders" Then For Each xorder In xChild.ChildNodes col = col + 1 'Debug.Print Split(xorder.XML, """")(1) writeArray(1, col) = Split(xorder.XML, """")(1) col = col + 1 'Debug.Print xorder.Text writeArray(1, col) = xorder.Text Next xorder ElseIf xChild.Text = "" Then col = col + 1 'Debug.Print Split(xChild.XML, """")(1) writeArray(1, col) = Split(xChild.XML, """")(1) Else col = col + 1 'debug.Print xChild.Text writeArray(1, col) = xChild.Text End If Next xChild Sheet1.Range("A5:J5").Value = writeArray End Sub