Html 为Web查询提交或绕过表单

我正试图将美元汇率从Excel电子表格中输入

我尝试粘贴为可刷新的web查询，但是，页面会提前一步打开一个表单，该表单有默认输入（对我来说很有用），然后查询会从该页面复制内容

我试图写一个代码来提交表单。我尝试了

.submit

，

。单击
，
。FireEvent
以及在internet上找到的许多其他东西

我试图通过名称、类、标记等来引用按钮

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



我试图直接触发表单或绕过表单

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

您可以使用bcb.gov.br

发送一个JSON响应请求，请求的转换率来自他们的服务器

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

使用并设置将响应转换为JSON对象并使用该对象
将响应解析为带有正则表达式的字符串以获取值

查看以下网站上今天的费率结果：

输入：

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

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


输出：

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

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


结果：

你可以看到1美元=37048巴西里拉


① 使用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”）
是一组字典，我感兴趣的值，
37048
——记住上面的网站图片，存储为
“CotaCoCompra”

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


代码：

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

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

脚本输出：

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

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



注意事项：

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

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

需要添加JSONConverter bas和VBE>Tools>References>Microsoft脚本运行时）


② 使用正则表达式解析responseText以获取速率：
我将使用的正则表达式是

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

这将查找文本字符串
“CotaCoCompra:
，后跟1个或多个数字，然后是“.”，然后是多个数字中的一个


然后，我必须删除字符串
“CotaCoCompra”：
，并直接替换。理想情况下，我只需使用
“（？）提取数字？