Html 使用 XMLHTTP 使用 vba 进行网页抓取
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/21639724/
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
web scraping with vba using XMLHTTP
提问by Figlio
I would like to get some data from web page http://www.eex.com/en/market-data/power/derivatives-market/phelix-futures.
我想从网页http://www.eex.com/en/market-data/power/derivatives-market/phelix-futures获取一些数据。
If I'm using the old InternetExplorer object (code below), I could walking through HTML document. But I would like to use XMLHTTPobject (second code).
如果我使用旧的 InternetExplorer 对象（下面的代码），我可以遍历 HTML 文档。但我想使用XMLHTTP对象（第二个代码）。
Sub IEZagon()
'we define the essential variables
Dim ie As Object
Dim TDelement, TDelements
Dim AnhorLink, AnhorLinks
'add the "Microsoft Internet Controls" reference in your VBA Project indirectly
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.navigate ("[URL]http://www.eex.com/en/market-data/power/derivatives-market/phelix-futures[/URL]")
While ie.ReadyState <> 4
DoEvents
Wend
Set AnhorLinks = .document.getElementsbytagname("a")
Set TDelements = .document.getElementsbytagname("td")
For Each AnhorLink In AnhorLinks
Debug.Print AnhorLink.innertext
Next
For Each TDelement In TDelements
Debug.Print TDelement.innertext
Next
End With
Set ie = Nothing
End Sub
Using code with XMLHTTP object:
使用带有 XMLHTTP 对象的代码：
Sub FuturesScrap(ByVal URL As String)
Dim XMLHttpRequest As XMLHTTP
Dim HTMLDoc As New HTMLDocument
Set XMLHttpRequest = New MSXML2.XMLHTTP
XMLHttpRequest.Open "GET", URL, False
XMLHttpRequest.send
While XMLHttpRequest.readyState <> 4
DoEvents
Wend
Debug.Print XMLHttpRequest.responseText
HTMLDoc.body.innerHTML = XMLHttpRequest.responseText
With HTMLDoc.body
Set AnchorLinks = .getElementsByTagName("a")
Set TDelements = .getElementsByTagName("td")
For Each AnchorLink In AnchorLinks
Debug.Print AnhorLink.innerText
Next
For Each TDelement In TDelements
Debug.Print TDelement.innerText
Next
End With
End Sub
I get only basic HTML:
我只得到基本的 HTML：
<html>
<head>
<title>Resource Not found</title>
<link rel= 'stylesheet' type='text/css' href='/blueprint/css/errorpage.css'/>
</head>
<body>
<table class="header">
<tr>
<td class="CMTitle CMHFill"><span class="large">Resource Not found</span></td>
</tr>
</table>
<div class="body">
<p style="font-weight:bold;">The requested resource does Not exist.</p>
</div>
<table class="footer">
<tr>
<td class="CMHFill"> </td>
</tr>
</table>
</body>
</html>
I would like to walking through tables and coresponding data... And finally I would like to select diferent time interval from Year to Month:
我想浏览表格和相应的数据......最后我想从年到月选择不同的时间间隔：
I'd really appreciate any help! Thank you!
我真的很感激任何帮助！谢谢！
回答by Graham Anderson
I can confirm that I get the same HTML as you when I run your code (with or without the url tags). I found a useful post here. I have modified your code using the method found there and it now appears to have downloaded the correct information.
我可以确认当我运行你的代码（有或没有 url 标签）时，我得到了与你相同的 HTML。我在这里找到了一个有用的帖子。我已经使用在那里找到的方法修改了您的代码，现在它似乎已经下载了正确的信息。
Sub test()
Call FuturesScrap1("http://www.eex.com/en/market-data/power/derivatives-market/phelix-futures")
End Sub
I included the calling sub because the url tags appeared to cause an error for the MSXML request.
我包含了调用子程序，因为 url 标记似乎会导致 MSXML 请求出错。
Sub FuturesScrap1(ByVal URL As String)
Dim HTMLDoc As New HTMLDocument
Dim oHttp As MSXML2.XMLHTTP
Dim sHTML As String
Dim AnchorLinks As Object
Dim TDelements As Object
Dim TDelement As Object
Dim AnchorLink As Object
On Error Resume Next
Set oHttp = New MSXML2.XMLHTTP
If Err.Number <> 0 Then
Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
MsgBox "Error 0 has occured while creating a MSXML.XMLHTTPRequest object"
End If
On Error GoTo 0
If oHttp Is Nothing Then
MsgBox "For some reason I wasn't able to make a MSXML2.XMLHTTP object"
Exit Sub
End If
'Open the URL in browser object
oHttp.Open "GET", URL, False
oHttp.send
sHTML = oHttp.responseText
Debug.Print oHttp.responseText
HTMLDoc.body.innerHTML = oHttp.responseText
With HTMLDoc.body
Set AnchorLinks = .getElementsByTagName("a")
Set TDelements = .getElementsByTagName("td")
For Each AnchorLink In AnchorLinks
Debug.Print AnchorLink.innerText
Next
For Each TDelement In TDelements
Debug.Print TDelement.innerText
Next
End With
End Sub
Edit folowing comment:
编辑以下评论：
I haven't been able to find the table elements using MSXML2 object, the source code doesn't appear to contain them. In firebug the td tags are present so I thik that the table is generated by the JavaScript code. I don't know if MSXML2 can run the JavaScript so I've modified the sub to use internet explorer, it's not quick code, but it does find the td elements and does allow clicking the tabs. I have found that the td elements can take some time to become available (presumably for IE has to run the JavaScript) so I have put in a couple of steps where xl waits before downloading the data.
我无法使用 MSXML2 对象找到表元素，源代码似乎不包含它们。在 firebug 中存在 td 标签，所以我认为该表是由 JavaScript 代码生成的。我不知道 MSXML2 是否可以运行 JavaScript，所以我修改了 sub 以使用 Internet Explorer，它不是快速代码，但它确实找到了 td 元素并允许单击选项卡。我发现 td 元素可能需要一些时间才能可用（大概对于 IE 必须运行 JavaScript），所以我在下载数据之前执行了几个步骤，其中 xl 等待。
I have put in some code that will download the contents of the td elements into the active worksheet, be careful if running it in a workbook with useful data in it.
我已经放入了一些将 td 元素的内容下载到活动工作表中的代码，如果在包含有用数据的工作簿中运行它，请小心。
Sub FuturesScrap3(ByVal URL As String)
Dim HTMLDoc As New HTMLDocument
Dim AnchorLinks As Object
Dim tdElements As Object
Dim tdElement As Object
Dim AnchorLink As Object
Dim lRow As Long
Dim oElement As Object
Dim oIE As InternetExplorer
Set oIE = New InternetExplorer
oIE.navigate URL
oIE.Visible = True
Do Until (oIE.readyState = 4 And Not oIE.Busy)
DoEvents
Loop
'Wait for Javascript to run
Application.Wait (Now + TimeValue("0:01:00"))
HTMLDoc.body.innerHTML = oIE.document.body.innerHTML
With HTMLDoc.body
Set AnchorLinks = .getElementsByTagName("a")
Set tdElements = .getElementsByTagName("td") '
For Each AnchorLink In AnchorLinks
Debug.Print AnchorLink.innerText
Next AnchorLink
End With
lRow = 1
For Each tdElement In tdElements
Debug.Print tdElement.innerText
Cells(lRow, 1).Value = tdElement.innerText
lRow = lRow + 1
Next
'Clicking the Month tab
For Each oElement In oIE.document.all
If Trim(oElement.innerText) = "Month" Then
oElement.Focus
oElement.Click
End If
Next oElement
Do Until (oIE.readyState = 4 And Not oIE.Busy)
DoEvents
Loop
'Wait for Javascript to run
Application.Wait (Now + TimeValue("0:01:00"))
HTMLDoc.body.innerHTML = oIE.document.body.innerHTML
With HTMLDoc.body
Set AnchorLinks = .getElementsByTagName("a")
Set tdElements = .getElementsByTagName("td") '
For Each AnchorLink In AnchorLinks
Debug.Print AnchorLink.innerText
Next AnchorLink
End With
lRow = 1
For Each tdElement In tdElements
Debug.Print tdElement.innerText
Cells(lRow, 2).Value = tdElement.innerText
lRow = lRow + 1
Next tdElement
End sub
