x速率Excel VBA数据提取

时间:2018-11-06 21:43:11

标签: excel vba excel-vba web-scraping automation

我对Excel VBA来说还很陌生,但是我无法从以下网站提取数据:https://www.x-rates.com/historical/?from=CAD&amount=1&date=2018-11-05。我想使这个过程自动化,所以我每个月都能得到这些费率。据我所知,我从这里迷路了:

'启动一个名为SearchBot的新子程序

Sub SearchBot()

'dimension (declare or set aside memory for) our variables
Dim objIE As InternetExplorer 'special object variable representing the IE browser
Dim aEle As HTMLLinkElement 'special object variable for an <a> (link) element
Dim y As Integer 'integer variable we'll use as a counter
Dim result As String 'string variable that will hold our result link

'initiating a new instance of Internet Explorer and asigning it to objIE
Set objIE = New InternetExplorer

'make IE browser visible (False would allow IE to run in the background)
objIE.Visible = True

'navigate IE to this web page (a pretty neat search engine really)
objIE.navigate "https://www.x-rates.com/table/?from=CAD&amount=1"

任何帮助将不胜感激!

1 个答案:

答案 0 :(得分:1)

您可以使用以下内容。它使用XMLHTTP作为更快的检索方法。将昨天的日期连接到URL中以获取最新价格。按字母顺序排列的表是通过其类名称和索引位置选择的。

Option Explicit
Public Sub GetTable()
    Dim sResponse As String, html As HTMLDocument, ws As Worksheet, clipboard As Object

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.x-rates.com/historical/?from=CAD&amount=1&date=" & Format$(Date - 1, "yyyy-mm-dd"), False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With

    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Set html = New HTMLDocument

    With html
        .body.innerHTML = sResponse
        clipboard.SetText .querySelectorAll(".ratesTable").item(1).outerHTML
        clipboard.PutInClipboard
    End With     
    ws.Cells(1, 1).PasteSpecial 
End Sub

参考(VBE>工具>参考):

  1. Microsoft HTML对象库