How to parse XML using vba

前端 未结 8 1085
不思量自难忘°
不思量自难忘° 2020-11-22 08:46

I work in VBA, and want to parse a string eg



        
相关标签:
8条回答
  • 2020-11-22 09:09

    You can use a XPath Query:

    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
    
    0 讨论(0)
  • 2020-11-22 09:11

    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.

    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:

    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
    
    0 讨论(0)
  • 2020-11-22 09:18

    Add reference Project->References Microsoft XML, 6.0 and you can use example code:

        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

    0 讨论(0)
  • 2020-11-22 09:19

    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.

    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.

    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.

    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.

    sample function

    
    openTag = ""
    closeTag = "" 
    
    ' 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)
    0 讨论(0)
  • 2020-11-22 09:23

    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.

    You can find more on MSXML2.DOMDocument at the following sites:

    • Manipulating XML files with Excel VBA & Xpath
    • MSXML - http://msdn.microsoft.com/en-us/library/ms763742(VS.85).aspx
    • An Overview of MSXML 4.0
    0 讨论(0)
  • 2020-11-22 09:23

    This is an example OPML parser working with FeedDemon opml files:

    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):

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

    0 讨论(0)
提交回复
热议问题