提交表单并从网站 VBA 中获取数据
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18173320/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Submit form and fetch data from website VBA
提问by Simon
I'm trying to fetch data from this siteusing VBA in Excel. What I tried to do and what worked was using InternetExplorer object like this:
我正在尝试使用 Excel 中的 VBA从该站点获取数据。我尝试做的和有效的是使用 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
However this worked very slow and didn't get always the right results. I suspect that sometimes it didn't wait until webpage was loaded. I tried to look for answers and I found this answer on stackoverflow. Now I'm trying to figure out how to rewrite my macro using MSXML2 and MSHTML. So far I was able to do this :
然而，这工作非常缓慢，并且并不总是得到正确的结果。我怀疑有时它没有等到网页加载。我试图寻找答案，我在 stackoverflow 上找到了这个答案。现在我想弄清楚如何使用 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"
please, why HTMLDoc has method getElementById and htmlBody doesn't ? How could I submit form "USFsecuritySearchDropDownForm". I tried this :
拜托，为什么 HTMLDoc 有方法 getElementById 而 htmlBody 没有？我如何提交表单“USFsecuritySearchDropDownForm”。我试过这个：
HTMLDoc.getElementById("USFsecuritySearchDropDownForm").submit
, but it always open new window in my default browser, I would like to have it hidden. It seems to me that I am missing difference between XMLHTTP60 and MSHTML.HTMLDocument. If you could please help me or at least show me where I can find this information I would be really thankful...
，但它总是在我的默认浏览器中打开新窗口，我想隐藏它。在我看来，我缺少 XMLHTTP60 和 MSHTML.HTMLDocument 之间的区别。如果你能帮助我，或者至少告诉我在哪里可以找到这些信息，我将非常感激......
回答by Dick Kusleika
XMLHTTP sends an http request to the webserver and receives back a response. MSHTML receives a string and renders the HTML. When you use them together, XMLHTTP gets the webserver response and MSHTML puts that response in a form you can use.
XMLHTTP 向网络服务器发送一个 http 请求并接收回一个响应。MSHTML 接收一个字符串并呈现 HTML。当您将它们一起使用时，XMLHTTP 获得 Web 服务器响应，而 MSHTML 将该响应置于您可以使用的形式中。
I think you don't need to submit anything. If you go to the site and type in the ticker, you get to a page like
我认为你不需要提交任何东西。如果您访问该站点并输入代码，您将进入一个页面，例如
That has the ticker in it. You can "GET" that URL directly and get whatever information you need from the html that's returned. This example gets what I assume is the stock price.
里面有股票代码。您可以直接“获取”该 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
Post Example
发布示例
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
