将 XML 文档中的数据解析为 Excel 工作表
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/12689352/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Parse Data in XML Document to Excel Worksheet
提问by user1714065
<?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>
This well formed XML document feeds to Excel 2007 using MS VBA code. I was successful
with using DOMDocumentand IXMLDOMElementto import the Name, City, and Product.
However, the xa:MeContext id, vsData1 id, VsData2 id, CustID, and order Orderidnumber won't export to Excel sheet.
这个格式良好的 XML 文档使用 MS VBA 代码提供给 Excel 2007。我成功地使用DOMDocument并IXMLDOMElement导入了名称、城市和产品。
然而，xa:MeContext id，vsData1 id，VsData2 id，CustID，和order Orderid数量不会导出到Excel工作表。
Each Excel row has the following headers with data filled from XML document:
每个 Excel 行都有以下标题，其中包含从 XML 文档填充的数据：
MeContextID--vsData1--VsData2--CustID--Name--City--OrderID--Product--OrderID--Product
回答by user3357963
Below are two methods to output the fields you need. Note, that the XML you have posted does not contain the header definitions for namespace "xa:" so is not fully formed XML. I've removed them in the example so MSXML2.DOMDocument doesn't throw a parse error.
以下是输出所需字段的两种方法。请注意，您发布的 XML 不包含名称空间“xa:”的标头定义，因此不是完全形成的 XML。我在示例中删除了它们，因此 MSXML2.DOMDocument 不会引发解析错误。
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
And the following uses regex, which is really only useful if the XML is fixed to exactly your example each time. It's not really recommended for parsing XML in general unless you want speed over reliability.
下面使用正则表达式，这实际上只有在每次将 XML 固定到您的示例时才有用。除非您希望速度超过可靠性，否则通常不建议将其用于解析 XML。
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
EDIT: Slight update to output to array for writing to range
编辑：轻微更新输出到数组以写入范围
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
