Отправить форму и получить данные с сайта VBA

Question

Я пытаюсь получить данные с этого сайта, используя VBA в Excel. То, что я пытался сделать и что работало, было использовать объект InternetExplorer, как это:

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
IE.Navigate "http://zertifikate.finanztreff.de"
IE.document.getElementById("USFsecuritySearchDropDown").Value = "DE000BP5TBQ2"
IE.document.getElementById("USFsecuritySearchDropDownForm").submit

Do While IE.Busy Or IE.readyState <> 4  'wait until page is loaded
    Application.Wait DateAdd("s", 1, Now)
Loop
MsgBox IE.document.getElementById("BP5TBQ~30~5").innerHTML

Однако это работало очень медленно и не всегда давало правильные результаты. Я подозреваю, что иногда она не дожидалась загрузки веб-страницы. Я попытался найти ответы, и я нашел этот ответ на stackru. Теперь я пытаюсь выяснить, как переписать мой макрос, используя MSXML2 и MSHTML. Пока я смог сделать это:

Dim IE As MSXML2.XMLHTTP60
Set IE = New MSXML2.XMLHTTP60

IE.Open "GET", "http://zertifikate.finanztreff.de", False
IE.send
While IE.ReadyState <> 4
    DoEvents
Wend

Dim HTMLDoc As MSHTML.HTMLDocument
Dim htmlBody As MSHTML.htmlBody

Set HTMLDoc = New MSHTML.HTMLDocument
Set htmlBody = HTMLDoc.body
htmlBody.innerHTML = IE.responseText
HTMLDoc.getElementById("USFsecuritySearchDropDown").Value = "DE000BP5TBQ2"

пожалуйста, почему HTMLDoc имеет метод getElementById, а htmlBody - нет? Как я могу отправить форму "USFsecuritySearchDropDownForm". Я попробовал это:

 HTMLDoc.getElementById("USFsecuritySearchDropDownForm").submit

, но он всегда открывает новое окно в моем браузере по умолчанию, я хотел бы скрыть его. Мне кажется, что мне не хватает разницы между XMLHTTP60 и MSHTML.HTMLDocument. Если бы вы могли помочь мне или хотя бы показать мне, где я могу найти эту информацию, я был бы очень благодарен...

Answer 1

XMLHTTP отправляет http-запрос веб-серверу и получает ответ. MSHTML получает строку и отображает HTML. Когда вы используете их вместе, XMLHTTP получает ответ веб-сервера, а MSHTML помещает этот ответ в форму, которую вы можете использовать.

Я думаю, вам не нужно ничего отправлять. Если вы заходите на сайт и вводите тикер, вы попадаете на страницу

http://zertifikate.finanztreff.de/dvt_einzelkurs_uebersicht.htn?seite=zertifikate&i=22558284&suchbegriff=DE000BP5TBQ2&exitPoint=

В этом есть тикер. Вы можете "получить" этот URL-адрес напрямую и получить всю необходимую информацию из возвращенного HTML. Этот пример получает то, что я предполагаю, это цена акций.

Sub GetPrice()

    Dim xHttp As MSXML2.XMLHTTP
    Dim hDoc As MSHTML.HTMLDocument
    Dim hDiv As HTMLDivElement
    Dim hTbl As HTMLTable

    Const sTICKER As String = "DE000BP5TBQ2"

    Set xHttp = New MSXML2.XMLHTTP

    xHttp.Open "GET", "http://zertifikate.finanztreff.de/dvt_einzelkurs_uebersicht.htn?seite=zertifikate&i=22558284&suchbegriff=" & sTICKER & "&exitPoint="
    xHttp.send

    Do Until xHttp.readyState = 4
        DoEvents
    Loop

    If xHttp.Status = 200 Then
        Set hDoc = New MSHTML.HTMLDocument
        hDoc.body.innerHTML = xHttp.responseText

        'Get the third TD in the first TABLE in the first DIV whose class is 'tape'
        Set hDiv = hDoc.getElementsByClassName("tape").Item(0)
        Set hTbl = hDiv.getElementsByTagName("table").Item(0)
        Debug.Print hTbl.getElementsByTagName("td").Item(2).innerText
    End If

End Sub

Пример публикации

Sub GetPriceByPost()

    Dim xHttp As MSXML2.XMLHTTP
    Dim hDoc As MSHTML.HTMLDocument
    Dim hDiv As HTMLDivElement
    Dim hTbl As HTMLTable

    Const sTICKER As String = "i=635957"

    Set xHttp = New MSXML2.XMLHTTP

    xHttp.Open "POST", "http://fonds.finanztreff.de/fonds_einzelkurs_uebersicht.htn"
    xHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    xHttp.send sTICKER

    Do Until xHttp.readyState = 4
        DoEvents
    Loop

    If xHttp.Status = 200 Then
        Set hDoc = New MSHTML.HTMLDocument
        hDoc.body.innerHTML = xHttp.responseText

        'Get the third TD in the first TABLE in the first DIV whose class is 'tape'
        Set hDiv = hDoc.getElementsByClassName("tape").Item(0)
        Set hTbl = hDiv.getElementsByTagName("table").Item(0)
       Debug.Print hTbl.getElementsByTagName("td").Item(2).innerText
    Else
        Debug.Print xHttp.statusText
    End If

End Sub