Регулировка VBA для адаптивности - PullRequest
Новая
       13

Регулировка VBA для адаптивности

0 голосов
/ 21 ноября 2018

У меня есть этот код, который я хотел бы переписать, чтобы получить цену Bid от Yahoo.Код в настоящее время получает последнюю цену, однако я хотел бы получить цену Bid, а если цена Bid равна нулю, то получить последнюю цену.Я пытался полностью переписать его сам, но безуспешно.Может ли кто-нибудь помочь в моем стремлении переписать этот код.

Спасибо, любезно 

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

1 Ответ

0 голосов
/ 21 ноября 2018

Попробуйте следующее.Он должен принести вам цену предложения, если она больше 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(), проверьте эту ссылку .

...