代码之家 › 专栏 › 技术社区 › Error 1004

使用VBA从网站刮取值

web-scraping vba html

Error 1004 · 技术社区 · 7 年前

从网站上搜集一些数据所需的帮助。作为第一步,我设法访问网站并导入我的变量,但是:

1.我不知道怎么按“兑换货币”键 2.然后将“换算金额”和“汇率”转换为excel。

任何帮助都将不胜感激!!!

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

端接头

1 回复 | 直到 7 年前

QHarr 7 年前

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

Internet Explorer:

由于您在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可能会在输出时将日期从dd/mm/yyyy切换到mm/dd/yyyy,因此您需要更正此错误,或者至少要知道它。