如何使用 vba 解析 XML
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/11305/
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
How to parse XML using vba
提问by Devdatta Tengshe
I work in VBA, and want to parse a string eg
我在 VBA 中工作，想解析一个字符串，例如
<PointN xsi:type='typens:PointN'
xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'
xmlns:xs='http://www.w3.org/2001/XMLSchema'>
<X>24.365</X>
<Y>78.63</Y>
</PointN>
and get the X & Y values into two separate integer variables.
并将 X 和 Y 值放入两个单独的整数变量中。
I'm a newbie when it comes to XML, since I'm stuck in VB6 and VBA, because of the field I work in.
我是 XML 的新手，因为我被困在 VB6 和 VBA 中，因对我来说有效的领域。
How do I do this?
我该怎么做呢？
采纳答案by rjzii
This is a bit of a complicated question, but it seems like the most direct route would be to load the XML document or XML string via MSXML2.DOMDocument which will then allow you to access the XML nodes.
这是一个有点复杂的问题，但似乎最直接的途径是通过 MSXML2.DOMDocument 加载 XML 文档或 XML 字符串，然后允许您访问 XML 节点。
You can find more on MSXML2.DOMDocument at the following sites:
您可以在以下站点找到有关 MSXML2.DOMDocument 的更多信息：
回答by Devdatta Tengshe
Thanks for the pointers.
谢谢指点。
I don't know, whether this is the best approach to the problem or not, but here is how I got it to work. I referenced the Microsoft XML, v2.6 dll in my VBA, and then the following code snippet, gives me the required values
我不知道这是否是解决问题的最佳方法，但这是我让它工作的方法。我在 VBA 中引用了 Microsoft XML、v2.6 dll，然后下面的代码片段为我提供了所需的值
Dim objXML As MSXML2.DOMDocument
Set objXML = New MSXML2.DOMDocument
If Not objXML.loadXML(strXML) Then 'strXML is the string with XML'
Err.Raise objXML.parseError.ErrorCode, , objXML.parseError.reason
End If
Dim point As IXMLDOMNode
Set point = objXML.firstChild
Debug.Print point.selectSingleNode("X").Text
Debug.Print point.selectSingleNode("Y").Text
回答by mvanle
You can use a XPath Query:
您可以使用 XPath 查询：
Dim objDom As Object '// DOMDocument
Dim xmlStr As String, _
xPath As String
xmlStr = _
"<PointN xsi:type='typens:PointN' " & _
"xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' " & _
"xmlns:xs='http://www.w3.org/2001/XMLSchema'> " & _
" <X>24.365</X> " & _
" <Y>78.63</Y> " & _
"</PointN>"
Set objDom = CreateObject("Msxml2.DOMDocument.3.0") '// Using MSXML 3.0
'/* Load XML */
objDom.LoadXML xmlStr
'/*
' * XPath Query
' */
'/* Get X */
xPath = "/PointN/X"
Debug.Print objDom.SelectSingleNode(xPath).text
'/* Get Y */
xPath = "/PointN/Y"
Debug.Print objDom.SelectSingleNode(xPath).text
回答by No Name
Add reference Project->References Microsoft XML, 6.0 and you can use example code:
添加参考 Project->References Microsoft XML, 6.0，您可以使用示例代码：
Dim xml As String
xml = "<root><person><name>Me </name> </person> <person> <name>No Name </name></person></root> "
Dim oXml As MSXML2.DOMDocument60
Set oXml = New MSXML2.DOMDocument60
oXml.loadXML xml
Dim oSeqNodes, oSeqNode As IXMLDOMNode
Set oSeqNodes = oXml.selectNodes("//root/person")
If oSeqNodes.length = 0 Then
'show some message
Else
For Each oSeqNode In oSeqNodes
Debug.Print oSeqNode.selectSingleNode("name").Text
Next
End If
be careful with xml node //Root/Person is not same with //root/person, also selectSingleNode("Name").text is not same with selectSingleNode("name").text
注意xml节点 //Root/Person 与 //root/person 不同，selectSingleNode("Name").text 与 selectSingleNode("name").text 不同
回答by DK.
This is an example OPML parser working with FeedDemon opml files:
这是一个使用 FeedDemon opml 文件的示例 OPML 解析器：
Sub debugPrintOPML()
' http://msdn.microsoft.com/en-us/library/ms763720(v=VS.85).aspx
' http://msdn.microsoft.com/en-us/library/system.xml.xmlnode.selectnodes.aspx
' http://msdn.microsoft.com/en-us/library/ms256086(v=VS.85).aspx ' expressions
' References: Microsoft XML
Dim xmldoc As New DOMDocument60
Dim oNodeList As IXMLDOMSelection
Dim oNodeList2 As IXMLDOMSelection
Dim curNode As IXMLDOMNode
Dim n As Long, n2 As Long, x As Long
Dim strXPathQuery As String
Dim attrLength As Byte
Dim FilePath As String
FilePath = "rss.opml"
xmldoc.Load CurrentProject.Path & "\" & FilePath
strXPathQuery = "opml/body/outline"
Set oNodeList = xmldoc.selectNodes(strXPathQuery)
For n = 0 To (oNodeList.length - 1)
Set curNode = oNodeList.Item(n)
attrLength = curNode.Attributes.length
If attrLength > 1 Then ' or 2 or 3
Call processNode(curNode)
Else
Call processNode(curNode)
strXPathQuery = "opml/body/outline[position() = " & n + 1 & "]/outline"
Set oNodeList2 = xmldoc.selectNodes(strXPathQuery)
For n2 = 0 To (oNodeList2.length - 1)
Set curNode = oNodeList2.Item(n2)
Call processNode(curNode)
Next
End If
Debug.Print "----------------------"
Next
Set xmldoc = Nothing
End Sub
Sub processNode(curNode As IXMLDOMNode)
Dim sAttrName As String
Dim sAttrValue As String
Dim attrLength As Byte
Dim x As Long
attrLength = curNode.Attributes.length
For x = 0 To (attrLength - 1)
sAttrName = curNode.Attributes.Item(x).nodeName
sAttrValue = curNode.Attributes.Item(x).nodeValue
Debug.Print sAttrName & " = " & sAttrValue
Next
Debug.Print "-----------"
End Sub
This one takes multilevel trees of folders (Awasu, NewzCrawler):
这个需要多级文件夹树（Awasu，NewzCrawler）：
...
Call xmldocOpen4
Call debugPrintOPML4(Null)
...
Dim sText4 As String
Sub debugPrintOPML4(strXPathQuery As Variant)
Dim xmldoc4 As New DOMDocument60
'Dim xmldoc4 As New MSXML2.DOMDocument60 ' ?
Dim oNodeList As IXMLDOMSelection
Dim curNode As IXMLDOMNode
Dim n4 As Long
If IsNull(strXPathQuery) Then strXPathQuery = "opml/body/outline"
' http://msdn.microsoft.com/en-us/library/ms754585(v=VS.85).aspx
xmldoc4.async = False
xmldoc4.loadXML sText4
If (xmldoc4.parseError.errorCode <> 0) Then
Dim myErr
Set myErr = xmldoc4.parseError
MsgBox ("You have error " & myErr.reason)
Else
' MsgBox xmldoc4.xml
End If
Set oNodeList = xmldoc4.selectNodes(strXPathQuery)
For n4 = 0 To (oNodeList.length - 1)
Set curNode = oNodeList.Item(n4)
Call processNode4(strXPathQuery, curNode, n4)
Next
Set xmldoc4 = Nothing
End Sub
Sub processNode4(strXPathQuery As Variant, curNode As IXMLDOMNode, n4 As Long)
Dim sAttrName As String
Dim sAttrValue As String
Dim x As Long
For x = 0 To (curNode.Attributes.length - 1)
sAttrName = curNode.Attributes.Item(x).nodeName
sAttrValue = curNode.Attributes.Item(x).nodeValue
'If sAttrName = "text"
Debug.Print strXPathQuery & " :: " & sAttrName & " = " & sAttrValue
'End If
Next
Debug.Print ""
If curNode.childNodes.length > 0 Then
Call debugPrintOPML4(strXPathQuery & "[position() = " & n4 + 1 & "]/" & curNode.nodeName)
End If
End Sub
Sub xmldocOpen4()
Dim oFSO As New FileSystemObject ' Microsoft Scripting Runtime Reference
Dim oFS
Dim FilePath As String
FilePath = "rss_awasu.opml"
Set oFS = oFSO.OpenTextFile(CurrentProject.Path & "\" & FilePath)
sText4 = oFS.ReadAll
oFS.Close
End Sub
or better:
或更好：
Sub xmldocOpen4()
Dim FilePath As String
FilePath = "rss.opml"
' function ConvertUTF8File(sUTF8File):
' http://www.vbmonster.com/Uwe/Forum.aspx/vb/24947/How-to-read-UTF-8-chars-using-VBA
' loading and conversion from Utf-8 to UTF
sText8 = ConvertUTF8File(CurrentProject.Path & "\" & FilePath)
End Sub
but I don't understand, why xmldoc4 should be loaded each time.
但我不明白，为什么每次都要加载 xmldoc4。
回答by Tommie C.
Update
更新
The procedure presented below gives an example of parsing XML with VBA using the XML DOM objects. Code is based on a beginners guide of the XML DOM.
下面介绍的过程给出了使用 XML DOM 对象通过 VBA 解析 XML 的示例。代码基于XML DOM的初学者指南。
Public Sub LoadDocument()
Dim xDoc As MSXML.DOMDocument
Set xDoc = New MSXML.DOMDocument
xDoc.validateOnParse = False
If xDoc.Load("C:\My Documents\sample.xml") Then
' The document loaded successfully.
' Now do something intersting.
DisplayNode xDoc.childNodes, 0
Else
' The document failed to load.
' See the previous listing for error information.
End If
End Sub
Public Sub DisplayNode(ByRef Nodes As MSXML.IXMLDOMNodeList, _
ByVal Indent As Integer)
Dim xNode As MSXML.IXMLDOMNode
Indent = Indent + 2
For Each xNode In Nodes
If xNode.nodeType = NODE_TEXT Then
Debug.Print Space$(Indent) & xNode.parentNode.nodeName & _
":" & xNode.nodeValue
End If
If xNode.hasChildNodes Then
DisplayNode xNode.childNodes, Indent
End If
Next xNode
End Sub
Nota Bene- This initial answer shows the simplest possible thing I could imagine (at the time I was working on a very specific issue) . Naturally using the XML facilities built into the VBA XML Dom would be much better. See the updates above.
Nota Bene- 这个最初的答案展示了我能想象到的最简单的事情（当时我正在研究一个非常具体的问题）。自然地，使用内置于 VBA XML Dom 中的 XML 工具会好得多。请参阅上面的更新。
Original Response
原始回复
I know this is a very old post but I wanted to share my simple solution to this complicated question. Primarily I've used basic string functions to access the xml data.
我知道这是一篇很老的帖子，但我想分享我对这个复杂问题的简单解决方案。我主要使用基本的字符串函数来访问 xml 数据。
This assumes you have some xml data (in the temp variable) that has been returned within a VBA function. Interestingly enough one can also see how I am linking to an xml web service to retrieve the value. The function shown in the image also takes a lookup value because this Excel VBA function can be accessed from within a cell using = FunctionName(value1, value2) to return values via the web service into a spreadsheet.
这假设您有一些已在 VBA 函数中返回的 xml 数据（在 temp 变量中）。有趣的是，您还可以看到我如何链接到 xml Web 服务以检索值。图像中显示的函数也采用查找值，因为可以使用 = FunctionName(value1, value2) 从单元格内访问此 Excel VBA 函数，以通过 Web 服务将值返回到电子表格中。
openTag = "<" & tagValue & ">"
closeTag = "< /" & tagValue & ">"
' Locate the position of the enclosing tags
startPos = InStr(1, temp, openTag)
endPos = InStr(1, temp, closeTag)
startTagPos = InStr(startPos, temp, ">") + 1
' Parse xml for returned value
Data = Mid(temp, startTagPos, endPos - startTagPos)
回答by Bob Wheatley
Here is a short sub to parse a MicroStation Triforma XML file that contains data for structural steel shapes.
这是解析包含结构钢形状数据的 MicroStation Triforma XML 文件的简短子文件。
'location of triforma structural files
'c:\programdata\bentley\workspace\triforma\tf_imperial\data\us.xml
Sub ReadTriformaImperialData()
Dim txtFileName As String
Dim txtFileLine As String
Dim txtFileNumber As Long
Dim Shape As String
Shape = "w12x40"
txtFileNumber = FreeFile
txtFileName = "c:\programdata\bentley\workspace\triforma\tf_imperial\data\us.xml"
Open txtFileName For Input As #txtFileNumber
Do While Not EOF(txtFileNumber)
Line Input #txtFileNumber, txtFileLine
If InStr(1, UCase(txtFileLine), UCase(Shape)) Then
P1 = InStr(1, UCase(txtFileLine), "D=")
D = Val(Mid(txtFileLine, P1 + 3))
P2 = InStr(1, UCase(txtFileLine), "TW=")
TW = Val(Mid(txtFileLine, P2 + 4))
P3 = InStr(1, UCase(txtFileLine), "WIDTH=")
W = Val(Mid(txtFileLine, P3 + 7))
P4 = InStr(1, UCase(txtFileLine), "TF=")
TF = Val(Mid(txtFileLine, P4 + 4))
Close txtFileNumber
Exit Do
End If
Loop
End Sub
From here you can use the values to draw the shape in MicroStation 2d or do it in 3d and extrude it to a solid.
从这里您可以使用这些值在 MicroStation 2d 中绘制形状或在 3d 中绘制并将其拉伸为实体。
回答by TJ Wilkinson
Often it is easier to parse without VBA, when you don't want to enable macros. This can be done with the replace function. Enter your start and end nodes into cells B1 and C1.
当您不想启用宏时，通常在没有 VBA 的情况下更容易解析。这可以通过替换功能来完成。在单元格 B1 和 C1 中输入开始和结束节点。
Cell A1: {your XML here}
Cell B1: <X>
Cell C1: </X>
Cell D1: =REPLACE(A1,1,FIND(A2,A1)+LEN(A2)-1,"")
Cell E1: =REPLACE(A4,FIND(A3,A4),LEN(A4)-FIND(A3,A4)+1,"")
And the result line E1 will have your parsed value:
结果行 E1 将具有您的解析值：
Cell A1: {your XML here}
Cell B1: <X>
Cell C1: </X>
Cell D1: 24.365<X><Y>78.68</Y></PointN>
Cell E1: 24.365
