无法在XML spanclass中获得价值

Question

我正在尝试检索在线XML文件中某个spanclasses中的值。

档案：http://www.ecb.europa.eu/stats/eurofxref/eurofxref-daily.xml

我想达到美元汇率，但我的代码似乎没有循环和span-classes，我的错误在哪里？

我的代码

Function response_Text(url As String) ' get the responsetext from an xml request

Dim xml As Object
Set xml = CreateObject("MSXML2.XMLHTTP")

With xml
    .Open "Get", url, False
    .send
    response_Text = .responsetext
    End With

Set xml = Nothing

End Function

Private Sub find_ClassElement(HTML_doc As MSHTML.HTMLDocument) ' return value inside span_class

Dim ticker As Variant
Dim XML_elements As MSHTML.IHTMLElementCollection
Dim XML_spanclass As MSHTML.HTMLSpanElement
Dim XML_targetElement As MSHTML.HTMLLIElement

Set XML_elements = HTML_doc.getElementsByClassName("line") **<--- something seems to be wrong here, the code does not loop through any span_classes after this point as intended ( the for statement is not being executed )**

For Each XML_spanclass In XML_elements
    If InStr(XML_spanclass.innerHTML, "USD") > 0 Then
        Debug.Print "success"
        Set XML_targetElement = XML_spanclass.parentElement
        Debug.Print CSng(XML_targetElement.getElementsByClassName("webkit-html-attribute-value")(0).innerHTML)
    End If
    Next
End Sub


Private Sub run() ' run the whole operation

Dim http_req As http_req: Set http_req = New http_req
Dim xml As MSHTML.HTMLDocument: Set xml = New MSHTML.HTMLDocument

Dim url As String: url = "http://www.ecb.europa.eu/stats/eurofxref/eurofxref-daily.xml"

xml.body.innerHTML = http_req.response_Text(url)

Call find_ClassElement(xml)


End Sub

Answer 1

没有标有“＆＃34; line＆＃34;所以你的收藏是空的 - 无需循环。这是另一种方式

Sub GetUSD()

    Dim xHttp As MSXML2.XMLHTTP
    Dim xDoc As MSXML2.DOMDocument
    Dim xCube As MSXML2.IXMLDOMElement
    Dim xCubes As MSXML2.IXMLDOMSelection
    Dim sCurrency As String

    'load the xml document
    Set xDoc = New MSXML2.DOMDocument
    xDoc.Load "http://www.ecb.europa.eu/stats/eurofxref/eurofxref-daily.xml"

    'wait until it's completely loaded
    Do
        DoEvents
    Loop Until xDoc.readyState = 4

    'get all the cube tags
    Set xCubes = xDoc.getElementsByTagName("Cube")

    For Each xCube In xCubes
        'some cube tags don't have attributes
        On Error Resume Next
            sCurrency = xCube.Attributes(0).Text
        On Error GoTo 0

        'if the first attribute is USD, get the second attribute
        If sCurrency = "USD" Then
            Debug.Print xCube.Attributes(1).Text
        End If
    Next xCube

End Sub

修改

我不能很好地了解xpath以正确执行此操作，但这样做有效。

Sub GetUSD()

    Dim xDoc As MSXML2.DOMDocument60
    Dim xCube As MSXML2.IXMLDOMNode
    Dim xCubes As MSXML2.IXMLDOMNodeList
    Dim sCurrency As String

    'load the xml document
    Set xDoc = New MSXML2.DOMDocument60
    xDoc.Load "http://www.ecb.europa.eu/stats/eurofxref/eurofxref-daily.xml"

    'wait until it's completely loaded
    Do
        DoEvents
    Loop Until xDoc.readyState = 4

    'get all the cube tags
    Set xCubes = xDoc.SelectNodes("//*")

    For Each xCube In xCubes

        On Error Resume Next
            sCurrency = xCube.Attributes(0).NodeValue
        On Error GoTo 0

        'if the first attribute is USD, get the second attribute
        If sCurrency = "USD" Then
            Debug.Print xCube.Attributes(1).NodeValue
        End If
    Next xCube

End Sub