Excel Web查询提交问题

Question

我正在尝试从http://www4.bcb.gov.br/pec/taxas/port/ptaxnpesq.asp?id=txcotacao获取数据（美元汇率）到excel电子表格。

我已经尝试粘贴为可刷新的Web查询，但是，页面总是先使用表单打开一步，该表单已经默认输入（对我有效），然后查询从此页面复制内容。

我也尝试编写代码来提交表单，但我没有把它弄好。我尝试了.submit，.Click，.FireEvent和我在互联网上找到的许多其他东西。

我试着通过它的名字，类，标签来引用按钮......

<input title="Pesquisar" class="botao" onclick="limparVazio()" type="submit" value="Pesquisar">

我也试图直接触发表格或绕过它，但没有奏效

<form name="consultarBoletimForm" action="/ptax_internet/consultaBoletim.do?method=consultarBoletim" method="post">

任何人都可以帮我解决这段代码吗？

Answer 1

你可以使用bcb.gov.br Open Data Portal。

发送一个JSON响应请求，其转换率来自他们的Exchange rates – daily bulletins。

通过收到的响应以及其他方法，您可以：

1. 使用JSON Converter并将响应转换为JSON对象并使用它;
2. 将响应解析为带有正则表达式的字符串以获取值

---

看看今天site的结果：

输入：

输出：

结果：

您可以看到USD 1 = 3,7048 BRL

---

①使用JSON对象：

请求的示例字符串：

"https://olinda.bcb.gov.br/olinda/service/PTAX/version/v1/odata/ExchangeRatePeriod(moeda=@moeda,dataInicial=@dataInicial,dataFinalCotacao=@dataFinalCotacao)?%40moeda=%27" & TARGET_CURRENCY & "%27&%40dataInicial=%27" & START_DATE & "%27&%40dataFinalCotacao=%27" & END_DATE & "%27&%24format=json"

我在字符串中包含开始日期，结束日期和货币，并将响应格式指定为JSON。我选择的日期与上图中显示的网站视图相匹配。

JSON响应如下：

我将响应读入字符串变量，然后使用JsonConverter.ParseJson(strJSON)转换为存储在json变量中的JSON对象。快速检查结构：

开头“{”告诉我json是一本字典。

我还可以看到json("value")是一个字典集合，我感兴趣的价值，3,7048 - 记得从上面的网站图像，存储为"cotacaoCompra"。

因此，我可以使用以下脚本来访问该值。 JSON响应实际上在该日期的5个不同时间给出了费率。这些都打印出来了。我们可以看到Fechamento（收盘）公告汇率为3,7048。

---

码：

Option Explicit
Public Sub GetInfo()
    Dim strURL As String, strJSON As String, item As Variant, http As Object, json As Object
    Const TARGET_CURRENCY As String = "USD"
    Const START_DATE As String = "06-13-2018"
    Const END_DATE As String = "06-13-2018"

    strURL = "https://olinda.bcb.gov.br/olinda/service/PTAX/version/v1/odata/ExchangeRatePeriod(moeda=@moeda,dataInicial=@dataInicial,dataFinalCotacao=@dataFinalCotacao)?%40moeda=%27" & TARGET_CURRENCY & "%27&%40dataInicial=%27" & START_DATE & "%27&%40dataFinalCotacao=%27" & END_DATE & "%27&%24format=json"

    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", strURL, False
    http.send
    strJSON = http.responseText
    Set json = JsonConverter.ParseJson(strJSON)

    For Each item In json("value")
        Debug.Print "rate " & item("cotacaoCompra") & " at " & item("dataHoraCotacao")
    Next item
End Sub

脚本输出：

---

笔记：

需要添加JSONConverter bas和VBE>工具>参考> Microsoft Scripting RunTime）

---

②使用正则表达式解析responseText以获取费率：

我将使用的正则表达式是

"cotacaoCompra":\d{1,}.\d{1,}

这将查找文字字符串"cotacaoCompra":，后跟一个或多个数字，然后是“。”，然后是一个或多个数字。

然后我必须用直接替换删除字符串"cotacaoCompra":。理想情况下，我只想用"(?<=""cotacaoCompra"":)\d{1,}.\d{1,}"提取数字;基本上，之后说，但不包括"cotacaoCompra":。但这似乎并不受支持。

考虑到这一点，使用正则表达式获取费率的脚本：

码：

Public Sub GetInfo2()

    Dim strURL As String, strJSON As String, item As Variant, http As Object, json As Object
    Const TARGET_CURRENCY As String = "USD"
    Const START_DATE As String = "06-13-2018"
    Const END_DATE As String = "06-13-2018"

    strURL = "https://olinda.bcb.gov.br/olinda/service/PTAX/version/v1/odata/ExchangeRatePeriod(moeda=@moeda,dataInicial=@dataInicial,dataFinalCotacao=@dataFinalCotacao)?%40moeda=%27" & TARGET_CURRENCY & "%27&%40dataInicial=%27" & START_DATE & "%27&%40dataFinalCotacao=%27" & END_DATE & "%27&%24format=json"

    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", strURL, False
    http.send
    strJSON = http.responseText
    Dim Matches As Object
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = """cotacaoCompra"":\d{1,}.\d{1,}"  'The pattern I really wanted, "(?<=""cotacaoCompra"":)\d{1,}.\d{1,}", doesn't appear to be supported

        If Not .test(strJSON) Then Exit Sub
        Set Matches = .Execute(strJSON)

        Dim match As Object
        For Each match In Matches
            Debug.Print Replace(match, """cotacaoCompra"":", vbNullString)
        Next
    End With
End Sub