通过 Internet Explorer 进行屏幕抓取

Question

“老办法”通过 VBA 已经使用了很多年，它通过 Internet Explorer 定期查询下面的网站以收集天气。但是，现在调用 IE 时，它在 Edge 中打开并且代码失败。

我一直在尝试让相同的代码通过 XML v6 工作，并且几乎成功地使用了“新方法”。我可以加载单个页面，但我需要合并在网站上按下按钮之前将区号输入搜索框的逻辑。

输入框是HTMLDoc.getElementById("keyword").
按钮是 HTMLDoc.getElementsByTagName("button").

只有输入区域并按下按钮后，才会返回该区域的天气。

是否可以使用新方式进行此查询？

我了解到这可以通过 Selenium 和 VBA 中的 Web 驱动程序查询来实现。但是，我听说每次 Microsoft Edge 更新时，您都需要为 Web 驱动程序下载一个新的驱动程序，考虑到查询的基础程度，这似乎有点过头了。

老办法

//References: Microsoft Internet Controls, Microsoft HTML Object Library

Dim IE As New SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument
Dim HTMLInput As MSHTML.IHTMLElement
Dim HTMLButtons As MSHTML.IHTMLElementCollection

IE.Visible = True
IE.Navigate ("www.bom.gov.au/aviation/forecasts/taf/")
//issue is that ie does not seem to exist, think it is because this actually redirects to edge now so code crashes from this point

Do While IE.ReadyState <> READYSTATE_COMPLETE
Loop
Debug.Print IE.LocationName; IE.LocationURL

Set HTMLDoc = IE.Document
Set HTMLInput = HTMLDoc.getElementById("keyword")
HTMLInput.Value = "20"
Set HTMLButtons = HTMLDoc.getElementsByTagName("button")
HTMLButtons(0).Click

新方式

//References: Microsoft XML, v6.0

Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
    
XMLPage.Open "GET", "http://bom.gov.au/aviation/forecasts/taf/", False
XMLPage.send
    
HTMLDoc.body.innerHTML = XMLPage.responseText
Call ProcessHTMLPage(HTMLDoc)

Answer 1

使用 XMLHTTP，您必须像在浏览器中那样与网页交互，因为内容是静态的，现代网站大多动态生成内容。

从 DevTools 检查网站，似乎搜索触发了对 http://www.bom.gov.au/aviation/php/process.php 的 POST 请求，关键字作为数据 return 结果，这就是你所拥有的复制。

下面是使用 YBWP 作为关键字的示例代码（更改常量或适应您的代码）并将输出从单元格 A1:

开始插入到 Sheet1

Sub Test()
    Const searchKeyWord As String = "YBWP"
    
    Dim XMLPage As New MSXML2.XMLHTTP60
    Dim HTMLDoc As New MSHTML.HTMLDocument
    Dim requestData As String
    
    requestData = "keyword=" & searchKeyWord & "&type=search&page=TAF"
    
    XMLPage.Open "POST", "http://www.bom.gov.au/aviation/php/process.php", False
    XMLPage.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    XMLPage.send requestData 
   
    HTMLDoc.body.innerHTML = XMLPage.responseText
    
    Dim resultColl As Object
    Set resultColl = HTMLDoc.getElementsByTagName("p")
    
    Dim i As Long
    For i = 0 To resultColl.Length - 1
        ThisWorkbook.Worksheets("Sheet1").Cells(i + 1, 1).Value = resultColl(i).innerText
    Next i
End Sub

运行这将 return XMLPage.responseText 如下：

<h3>WEIPA YBWP</h3><p class="product">TAF YBWP 251217Z 2514/2602<br />10006KT 9999 SCT020<br />RMK<br />T 27 25 25 30 Q 1011 1009 1011 1012</p><p class="product">METAR YBWP 251230Z AUTO 00000KT 9999 // SCT027 SCT033 BKN047 28/24<br />Q1012 RMK RF00.0/000.0</p>

通过 Internet Explorer 进行屏幕抓取

Screen-scraping via Internet explorer

xml

vba

internet-explorer

screen-scraping