Question

我要重写这段代码，以从yahoo获取出价。该代码当前获取最后价格，但是我想获取出价，如果出价为零，则获取最新价格。我竭尽全力自己重写它，但没有成功。有人可以协助我重写此代码吗？

谢谢！

Sub GetRate()
    Dim XMLPage As New MSXML2.XMLHTTP60
    Dim htmlDoc As New MSHTML.HTMLDocument
    Dim URL As String
    Dim HTMLspans As MSHTML.IHTMLElementCollection
    Dim HTMLspan As MSHTML.IHTMLElement

    URL = "https://finance.yahoo.com/quote/AAP181221C00170000?p=AAP181221C00170000"

    XMLPage.Open "GET", URL, False
    XMLPage.send

    htmlDoc.body.innerHTML = XMLPage.responseText

    Set HTMLspans = htmlDoc.getElementsByTagName("span")

    For Each HTMLspan In HTMLspans
        If HTMLspan.className = "Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)" Then
            debug.Print HTMLspan.innerText
        End If
    Next HTMLspan

End Sub

Answer 1

尝试以下方法。如果出价价格大于0，它将获取您的买入价，否则将抢占您的最后价格：

Sub GetRate()
    Const Url$ = "https://finance.yahoo.com/quote/AAP181221C00170000?p=AAP181221C00170000"
    Dim S$, elem As Object, post As Object

    With New XMLHTTP60
        .Open "GET", Url, False
        .send
        S = .responseText
    End With

    With New HTMLDocument
        .body.innerHTML = S

        Set elem = .querySelector("td[data-test='BID-value'] > span")
        If elem.innerText = 0 Then
            Set post = .querySelector("#quote-market-notice").ParentNode.FirstChild
            MsgBox post.innerText
        Else: MsgBox elem.innerText
        End If
    End With
End Sub

除了.querySelector()以外，您尝试过的其他方法完全相同：

Sub GetRate()
    Const Url$ = "https://finance.yahoo.com/quote/AAP181221C00170000?p=AAP181221C00170000"
    Dim Http As New XMLHTTP60, Htmldoc As New HTMLDocument
    Dim elem As Object, post As Object

    With Http
        .Open "GET", Url, False
        .send
        Htmldoc.body.innerHTML = .responseText
    End With

    Set elem = Htmldoc.querySelector("td[data-test='BID-value'] > span")
    If elem.innerText = 0 Then
        Set post = Htmldoc.querySelector("#quote-market-notice").ParentNode.FirstChild
        MsgBox post.innerText
    Else: MsgBox elem.innerText
    End If
End Sub

要添加到库中的引用：

Microsoft xml,v6.0
Microsoft Html Object Library

如果您想了解.querySelector()的工作原理，请查看this link。

VBA调整以适应性

1 个答案: