Соскреб в сети с VBA - Раннее связывание VS Позднее связывание объекта HTMLDocument

Question

Я пытаюсь настроить автоматическое обновление стоимости акций на основе "https://finance.yahoo.com".

Мне нужно использовать Позднее связывание, которое не работает, в то время как раннее связывание работает просто отлично. Есть ли способ это исправить?

 Sub FetchFinanceInfoLateBinding()

    Dim XMLReq As Object
    Dim HTMLDoc As Object
    Dim post As Object, I&

    Set XMLReq = CreateObject("Msxml2.ServerXMLHTTP.6.0")
    'Set HTMLDoc = CreateObject("MSXML2.DOMDocument.6.0")
    Set HTMLDoc = CreateObject("htmlfile")

    XMLReq.Open "GET", "https://finance.yahoo.com/quote/BABA/cash-flow?p=BABA", False
    XMLReq.send
    HTMLDoc.body.innerHTML = XMLReq.responseText

    Set post = HTMLDoc.getElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)")(0)
    Debug.Print post.innerText


End Sub


Sub FetchFinanceInfoEarlyBinding()

    Dim XMLReq As New XMLHTTP60
    Dim HTMLDoc As New HTMLDocument
    Dim post As Object, I&

    XMLReq.Open "GET", "https://finance.yahoo.com/quote/BABA/cash-flow?p=BABA", False
    XMLReq.send
    HTMLDoc.body.innerHTML = XMLReq.responseText


    Set post = HTMLDoc.getElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)")(0)
    Debug.Print post.innerText

End Sub

Как упоминалось ранее, я хотел бы иметь возможность использовать позднюю привязку при настройке этого решения.

Answer 1

Как упомянуто в комментариях @omegastripes:

htmlfile с поздним связыванием использует версию IE ниже 9, которая не поддерживает метод .getElementsByClassName

.

Однако вы можете переопределить его:

Option Explicit
Public Sub FetchFinanceInfoLateBinding()
    Dim XMLReq As Object
    Dim HTMLDoc As Object
    Dim post As Object, I&

    Set XMLReq = CreateObject("Msxml2.ServerXMLHTTP.6.0")
    Set HTMLDoc = CreateObject("htmlfile")

    XMLReq.Open "GET", "https://finance.yahoo.com/quote/BABA/cash-flow?p=BABA", False
    XMLReq.send
    HTMLDoc.body.innerHTML = XMLReq.responseText

    MsgBox GetValue(XMLReq.responseText, """regularMarketPrice"":{""raw"":[0-9.]+,""fmt"":""(\d+\.\d+)""}")

End Sub
Public Function GetValue(ByVal inputString As String, ByVal sPattern As String) As String
    With CreateObject("vbscript.regexp")
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = sPattern
        If .test(inputString) Then
            GetValue = .Execute(inputString).item(10).SubMatches(0)
        Else
           GetValue = vbNullString
        End If
    End With
End Function

Попробуйте здесь регулярное выражение