时间戳

首页 > 解决方案 > 使用 VBA 从网站上抓取值

html - 使用 VBA 从网站上抓取值

问题描述

从网站上抓取一些数据需要帮助。作为第一步，我设法访问该网站并导入我的变量，但是：

1.我不知道如何按“兑换货币”按钮 2.然后让“兑换金额”和“汇率”变得优秀。

任何帮助将不胜感激！！！

Sub Test()

Dim IE As InternetExplorer

Dim Amount As String
Dim Source As String
Dim Target As String
Dim Datestring As String

Amount = 10000
Source = "Euro"
Target = "UK pound sterling"
Datestring = "03-08-2018"

'Open Browser and download data
Set IE = New InternetExplorer

With IE
    .Visible = True
    .Navigate "http://sdw.ecb.europa.eu/curConverter.do?sourceAmount=" & _
            Amount & _
            "&sourceCurrency=" & _
            Source & _
            "&targetCurrency=" & _
            Target & _
            "&inputDate=" & _
            Datestring & _
            "&submitConvert.x=209&submitConvert.y=10"

            submitConvert.Click

    While .Busy Or .readyState < 4: DoEvents: Wend

End With

结束子

标签： htmlvbaweb-scraping

解决方案

XmlHttpRequest (XHR)：

在没有打开浏览器的情况下更快地使用 XHR。

Option Explicit

Public Sub GetRates()
    Dim sResponse As String, i As Long, html As New HTMLDocument, clipboard As Object
    Dim sourceAmount As String, sourceCurrency As String, targetCurrency As String, inputDate As String
    sourceAmount = "10000"
    sourceCurrency = "EUR"
    targetCurrency = "GBP"
    inputDate = "03-08-2018"
    Dim url As String
    url = "http://sdw.ecb.europa.eu//curConverter.do?sourceAmount=" & sourceAmount & "&sourceCurrency=" & sourceCurrency & _
        "&targetCurrency=" & targetCurrency & "&inputDate=" & inputDate & "&submitConvert.x=52&submitConvert.y=8"

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With

    sResponse = Mid$(sResponse, InStr(1, sResponse, "<!DOCTYPE "))
    With html
       .body.innerHTML = sResponse
        Set clipboard = New MSForms.DataObject
        clipboard.SetText .querySelectorAll("table.tableopenpage").item(1).outerHTML
        clipboard.PutInClipboard
        ActiveSheet.Cells(1, 1).PasteSpecial
    End With
End Sub

不太健壮，但如果你只是想要

兑换金额：

.querySelectorAll("table.tableopenpage").item(1).getElementsbytagname("td")(7).innertext

和利率：

.querySelectorAll("table.tableopenpage").item(1).getElementsbytagname("td")(10).innertext

输出：

输出

参考：

Microsoft Forms Object Library (or add a userform to your project)
Microsoft HTML Object Library

IE浏览器：

由于您在 URL 中使用的查询字符串，数据已经存在。无需点击。

只需使用正确的货币缩写即可。

Option Explicit
Public Sub Test()
    Dim IE As InternetExplorer, Amount As String, Source As String, Target As String
    Dim Datestring As String, hTable As HTMLTable

    Amount = 10000
    Source = "EUR"
    Target = "GBP"
    Datestring = "03-08-2018"
    Dim url As String
    url = "http://sdw.ecb.europa.eu/curConverter.do?sourceAmount=" & _
          Amount & _
          "&sourceCurrency=" & _
          Source & _
          "&targetCurrency=" & _
          Target & _
          "&inputDate=" & _
          Datestring & _
          "&submitConvert.x=209&submitConvert.y=10"

    Set IE = New InternetExplorer

    With IE
        .Visible = True
        .navigate url

        While .Busy Or .readyState < 4: DoEvents: Wend
        Dim clipboard As Object
        Set clipboard = New MSForms.DataObject
        clipboard.SetText .document.getElementsByClassName("tableopenpage")(1).outerHTML
        clipboard.PutInClipboard
        ActiveSheet.Cells(1, 1).PasteSpecial
    End With
End Sub

如果对如何点击感兴趣：

1) 对货币使用正确的 3 个字母缩写。

2）您可以单击提交按钮：

.document.querySelector("input[name=submitConvert]").Click

它使用一个 CSS 选择器 

input[name=submitConvert]

这说

input带有标签的元素，其属性name值为submitconvert。

3）然后你需要一个

While .Busy Or .readyState < 4: DoEvents: Wend

允许页面刷新。

4）然后您可以使用以下方法获取结果表：

.document.querySelectorAll("table.tableopenpage").item(1)

这收集了所有带有标签table和类的元素tableopenpage。您想要其中的第二个，它是基于 0 的索引系统上的 1。

所需参考资料：

Microsoft Internet Controls
Microsoft HTML Object Library
Microsoft Forms Object Library

其他：

我发现一次性抓取表格更简单，但您可以针对费率，例如，更具体地说，使用 CSS 选择器：

a[target*=quickview]

请注意，Excel 可能会在输出时将 Date 从 dd/mm/yyyy 转换为 mm/dd/yyyy，因此您需要更正此问题，或者至少要意识到这一点。

推荐阅读