Question

我想问一下如何从HTML中获取数据，该HTML使用JavaScript在表格中显示数据。

http://www.oanda.com/currency/historical-rates/

我需要从网站提取各种货币汇率 - 从美元到其他货币，反之亦然。我尝试使用获取外部数据＆gt; 来自Excel中的Web 功能，但网站可能会保护这些类型的查询，因此我无法获得我想要的表格（错误消息说我不想查找货币退税率）。因为我需要在网站上输入原始货币和目标货币，所以我无法在不输入组织和目标货币的情况下获得该表。这是该公司唯一使用的认可网站，因此我必须坚持使用此网站。

每天我需要转换最多2k次，是否有任何VBA供我使用，以便我可以运行代码来自动提取汇率？

Answer 1

这将获得最近60天并输出到桌面上的csv文件。您可以根据需要更改URL的“USD”部分。

Sub GetRates()

    Dim myURL As String, sFilename As String
    Dim WinHttpReq As Object, oStream As Object

    myURL = "http://www.oanda.com/currency/historical-rates/download?quote_currency=USD&end_date=" & Format(Now(), "yyyy-m-d") & "&period=daily&display=absolute&rate=0&data_range=d60&price=bid&view=graph&base_currency_0=CAD&download=csv"
    sFilename = Environ$("USERPROFILE") & "\Desktop\rates.csv"


    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", myURL, False
    WinHttpReq.Send

    myURL = WinHttpReq.ResponseBody

    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.ResponseBody
        oStream.SaveToFile sFilename, 2
       oStream.Close
    End If

End Sub

Answer 2

非常感谢@S O！因为我是新手代码，我对你的代码做了一些调整，以获得各种类型的货币对汇率。

我在col A中保存了组织货币列表，在col B中保存了目标货币列表。

下面是我使用的代码：

Sub GetRates()

Dim myURL As String, sFilename As String
Dim WinHttpReq As Object, oStream As Object
Dim i As Long, lastrow As Long

With ActiveSheet
lastrow = Sheet1.Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To lastrow

myURL = "http://www.oanda.com/currency/historical-rates/download?quote_currency=" & Sheet1.Range("A" & i).Value & "&end_date=" & Format(Now(), "yyyy-m-d") & "&period=daily&display=absolute&rate=0&data_range=d60&price=bid&view=graph&base_currency_0=" & Sheet1.Range("B" & i).Value & "&download=csv"
sFilename = Environ$("USERPROFILE") & "\Desktop\" & Sheet1.Range("A" & i).Value & Sheet1.Range("B" & i).Value & ".csv"

Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send

myURL = WinHttpReq.ResponseBody

If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.ResponseBody
    oStream.SaveToFile sFilename, 2
   oStream.Close
End If

Next i
End With

End Sub

将数据从脚本（seajs）编写的网页导入Excel

2 个答案: