从网站上获取一系列的汇率

时间:2019-04-12 07:15:34

标签: excel vba

我正在尝试从网站上自动检索给定日期的一小笔货币汇率。

我希望得到一些建议

我尝试了两种方法:-

1)更新网页上的字段并尝试获取费率 2)使用xmlhttp发出服务器请求

但都没有起作用

我尝试的第一种方法是更新页面上的字段:-

objIE.navigate ("https://www.oanda.com/currency/converter/")

Do
    DoEvents
Loop Until objIE.readyState = READYSTATE_COMPLETE


objIE.document.getElementById("quote_currency_input").Value = "Utd. Arab Emir Dirham"
objIE.document.getElementById("base_currency_input").Value = "Pound Sterling"
objIE.document.getElementById("end_date_input").Value = "Apr 6, 2019"
objIE.document.getElementById("form_quote_currency_hidden").Value = "AED"
objIE.document.getElementById("form_base_currency_hidden").Value = "GBP"
objIE.document.getElementById("form_end_date_hidden").Value = "2019-04-06"
objIE.document.getElementById("form_end_date_hidden").FireEvent "onchange"

.Range("A1").Offset(i - 1, 1).Value = objIE.document.getElementById("base_amount_input").Value

然后我尝试使用xmlhttp:-

Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")

With xmlhttp
    .Open "POST", "https://www.oanda.com/currency/converter/", False
    .setRequestHeader "Content-Type", "application/json"
    .send "update?base_currency_0=AUD&quote_currency=GBP&end_date=2019-04-06&view=details&id=1&action=C&"
    Debug.Print .responseText
End With

但是我不知道如何获得利率!

1 个答案:

答案 0 :(得分:0)

这对我有用。服务器以JSON响应(VBA本身不支持JSON,但是有可用的库/模块可以帮助您解析它)。

Option Explicit

Private Sub GetRate()

    Dim xmlhttp As MSXML2.ServerXMLHTTP60 ' Add a reference for early binding.
    Set xmlhttp = New MSXML2.ServerXMLHTTP60

    Const BASE_URL As String = "https://www.oanda.com/currency/converter/update?"

    Dim urlWithQueryString As String
    urlWithQueryString = BASE_URL & "base_currency_0=" & Application.EncodeURL("AUD") & "&quote_currency=" & Application.EncodeURL("GBP") & "&end_date=" & Application.EncodeURL("2019-04-06") & "&view=details&id=1&action=C"

    With xmlhttp
        .Open "GET", urlWithQueryString, True

        .setRequestHeader "Accept", "text/javascript, text/html, application/xml, text/xml, */*"
        .setRequestHeader "Referer", "https://www.oanda.com/currency/converter/"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/73.0.3683.86 Safari/537.36"
        .setRequestHeader "X-Prototype-Version", "1.7"
        .setRequestHeader "X-Requested-With", "XMLHttpRequest"
        .send
        .waitForResponse

        MsgBox .responseText
    End With
End Sub
  • 上面的查询参数值均不需要URL编码(没有URL不安全字符),但是我还是这样做了。
  • 您可以将以上内容重构为一个函数,该函数接受base_currencyquote_currencyend_date的参数。
  • 我无法弄清楚参数idaction的作用是什么。我可以看到id在浏览器中发出的每个请求都增加了1(也许是某种客户端计数器,或者可能是用来促进服务器的请求缓存)。

一旦您将响应解析为一个结构,我认为您希望汇率出现在以下位置:

JSONresponse["data"]["rate_data"]["bidRates"][0]

如果您的Excel版本包含Power Query,则可以改用它来请求费率。好处是它可以(本机)处理JSON并且可以返回Excel表。缺点是Power Query拥有自己的编程语言M,但是M中的等效语言将类似于:

let
    url = "https://www.oanda.com/currency/converter/update",
    requestParameters = [base_currency_0 = "GBP", quote_currency = "AUD", end_date = "2019-04-06", view = "details", id = "1", action = "C"],
    requestHeaders = [
        Accept = "text/javascript, text/html, application/xml, text/xml, */*",
        Referer = "https://www.oanda.com/currency/converter/",
        #"User-Agent" = "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/73.0.3683.86 Safari/537.36",
        #"X-Prototype-Version" = "1.7",
        #"X-Requested-With" = "XMLHttpRequest"
    ],
    request = Web.Contents(url, [Query = requestParameters, Headers = requestHeaders]),
    json = Json.Document(request),
    rate = json[data][rate_data][bidRates]{0}
in
    rate

您将通过以下方式实现(取决于Excel版本):Excel > Data > Get Data > From Other Sources > Blank Query > Advanced Editor (top left) > replace any code with code above > Close & Load (top left) > Load to new sheet。 (如果您要在工作表中加载多个值,这将更加有用。)