Submit or bypass form for a Web Query - html

I'm trying to get dollar exchange rate from http://www4.bcb.gov.br/pec/taxas/port/ptaxnpesq.asp?id=txcotacao into a Excel spreadsheet.
I tried to paste as refreshable web query, however, the page opens one step earlier with a form, which has default inputs (that work for me) and then the query copies stuff from this page.
I tried to write a code to submit the form. I tried the .submit, .Click, .FireEvent and many other things I found on internet.
I tried to refer to the button by its name, class, tag, ...
<input title="Pesquisar" class="botao" onclick="limparVazio()" type="submit" value="Pesquisar">
I tried to trigger the form directly or bypass it
<form name="consultarBoletimForm" action="/ptax_internet/consultaBoletim.do?method=consultarBoletim" method="post">

You can use the bcb.gov.br Open Data Portal.
Send a request for a JSON response with the conversion rates from their Exchange rates – daily bulletins.
With the received response, amongst other methods, you can then:
Use the JSON Converter and set the convert the response into a JSON object and work with that;
Parse the response as a string with a regex to get the values
Looking at the results for today's rate on the site:
Input:
Output:
Result:
You can see USD 1 = 3,7048 BRL
① Using JSON object:
Example string to make request:
"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"
I include the start date, end date and currency in the string as well as specify the response format as JSON. I have selected the date to match the website view shown in the images above.
The JSON response is as follows:
I read the response into a string variable and then use JsonConverter.ParseJson(strJSON) to convert to a JSON object, stored in json variable. A quick inspection of the structure:
The begining "{" tells me that json is a dictionary.
I can also see that json("value") is a collection of dictionaries and that the value I am interested in, 3,7048 - remember from the website images above, is stored as "cotacaoCompra".
I can thus use the following script to access that value. The JSON response actually gives rates at 5 different times on that date in question. These are all printed out. The Fechamento (Closing) bulletin rate of 3,7048 we can see matches.
Code:
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
Script output:
Notes:
Requires JSONConverter bas added and VBE > Tools > References > Microsoft Scripting RunTime)
② Parsing the responseText with a regex to get the rates:
The regex I will use is
"cotacaoCompra":\d{1,}.\d{1,}
This looks for the literal string "cotacaoCompra":, followed by 1 or more numbers then a ".", then one of more numbers.
I then have to remove the string "cotacaoCompra": with a straight forward replace. Ideally, I would just extract the numbers with "(?<=""cotacaoCompra"":)\d{1,}.\d{1,}"; basically, that says after, but not including "cotacaoCompra":. But that doesn't appear to be supported.
With that in mind the script to get the rates with regex:
Code:
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

Related

How to pull JSON values into Excel sheet

I am trying to pull JSON values from a URL that I am working with at the moment. I may have done something like this before but I dont know what I'm missing here.
Here is the URL - https://eu-offering.kambicdn.org/offering/v2018/888/listView/golf.json?lang=en_GB&market=GB&client_id=2&channel_id=1&ncid=1568916879040&useCombined=true
And an image for clarity of what is needed to be extracted.
I ran a test using Tinman's approach as can be found here - How to get, JSON values to Work in VBA-JSON? , but i can't even apply his function, PrintJSONAccessors(), here
Public Sub exceljson()
Dim http As Object
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET",
"https://eu-offering.kambicdn.org/offering/v2018/888/listView/golf.json?lang=en_GB&market=GB&client_id=2&channel_id=1&ncid=1568916879040&useCombined=true", False
http.Send
Dim results As Variant
results = BitfinexTextToArray(http.responseText)
Worksheets(1).Range("A1").Resize(UBound(results), UBound(results,2)).Value = results
MsgBox ("complete")
End Sub
Function BitfinexTextToArray(responseText As String) As Variant
Dim item As Variant, JSON As Object
Dim MaxColumns As Long
Set JSON = ParseJson(responseText)
For Each item In JSON
If item.Count > MaxColumns Then MaxColumns = item.Count
Next
Dim results As Variant
ReDim results(1 To JSON.Count, 1 To MaxColumns)
Dim c As Long, r As Long
For Each item In JSON
r = r + 1
For c = 1 To item.Count
results(r, c) = item(c)
Next
Next
BitfinexTextToArray = results
End Function
I need help with pulling the following item values from each of the JSON "event"
1. "englishName"
2. "participant"
3. "oddsFractional"
NOTE: my example uses the JsonConverter library and requires you to add a reference to the Microsoft Scripting Runtime to access the Dictionary object.
I set up a test file with JSON loaded from your URL above. After parsing the JSON data, the exercise becomes understanding how the various levels are nested and what type of data structure is being used. In your JSON, it's a mix of Collection, Array, and Dictionary in various combinations. My example below shows how you have to stack up these nested references to get the data you're looking for.
Review the information in this answer to understand how the JSON is parsed into a hierarchical data structure.
Option Explicit
Public Sub test()
Dim fileNum As Long
fileNum = FreeFile()
Dim filename As String
filename = "C:\Temp\testdata.json"
Dim jsonInput As String
Open filename For Input As #fileNum
jsonInput = Input$(LOF(fileNum), fileNum)
Close fileNum
Dim json As Object
Set json = ParseJson(jsonInput)
Debug.Print " English Name = " & json("events")(1)("event")("englishName")
Debug.Print " Participant = " & json("events")(1)("betOffers")(1)("outcomes")(2)("participant")
Debug.Print "Odds Fractional = " & json("events")(1)("betOffers")(1)("outcomes")(2)("oddsFractional")
End Sub
An even better solution will be to create an intermediate variable and then loop over the contents in an array (or collection or dictionary).

Scrape data from xmlhttp

I'm trying to scrape elements from xmlhttp.
I'm not too bad with vba, but relatively new to data scraping.
I have previously been using ie.
I can import the html into a cell, but would like to import specifically, the name, id, price and stock level.
The code I'm using to import the data is
Private Sub HTML_VBA_Excel()
Dim oXMLHTTP As Object
Dim sPageHTML As String
Dim sURL As String
'Change the URL before executing the code
sURL = "https://www.superdrug.com/Make-Up/Lips/Lip-Kits/Flower-Beauty-Mix-N%27-Matte-Lipstick-Duo-Tickled-Pink-687/p/769466"
'Extract data from website to Excel using VBA
Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oXMLHTTP.Open "GET", sURL, False
oXMLHTTP.send
sPageHTML = oXMLHTTP.responseText
'Get webpage data into Excel
sh02.Cells(1, 1) = sPageHTML
End Sub
Thanks in advance for any help received.
Ian
You cannot extract the information reliably from an xmlhttp request issued against the url you show as the content is javascript loaded and will not have run.
Not sure how sustainable the token is (doesn't seem to matter the value used) but you can join the productid, which is the end of your url, with the ajax token present in the page and issue and xmlhttp request using querystring parameters and parse a json response for the items of interest. I use jsonconverter.bas. After downloading and installing the .bas you need to go VBE > Tools > References and add a reference to Microsoft Scripting Runtime.
Some testing seems to indicate any number can be added after the hyphen in place of the token so you could randomly generate a number on the fly to use.
It's worth noting you can comma separate multiple products in the query string and thus do a bulk request. You would need then do a For Each Loop over the collection of dictionaries returned.
Option Explicit
Public Sub GetInfo()
Const URL As String = "https://www.superdrug.com/micrositeProduct/bulk/769466-1548702898380"
Dim json As Object, title As String, price As String, stocking As String, id As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
Set json = jsonconverter.ParseJson(.responsetext)(1)
End With
title = json("name")
price = json("price")("formattedValue") 'json("price")("value")
stocking = json("stockLevel")
id = json("code")
End Sub
If you use a browser then the json string is present within one the script tags as the .innerHTML and you can easily extract from there.

Harvesting few fields from json response

I've written a script in vba to get some fields from a link which contains json data. As I've never worked with json in combination with vba, I don't have any idea which way I pursue. I heard that power query is an option but that would be difficult for me to cope up. Any alternative solution as to how I can get those fields depicted in the below image.
This is I've tried:
Sub CollectInformation()
Dim ReqHttp As New XMLHTTP60, Ohtml As New HTMLDocument
weblink = "https://torontolife.com/wp-content/themes/sjm-underscores/inc/neighbourhoods/2015/compiled.json"
With ReqHttp
.Open "GET", weblink, False
.send
Ohtml.body.innerHTML = .responseText
MsgBox .responseText ''I can see the valid response in the messagebox
End With
End Sub
Fields I'm interested in:
A piece of scattered chunck:
"features":[{"type":"Feature","properties":{"HOOD":"Trinity-Bellwoods","center":"43.65241687364585 -79.41651445205076","streetview":{"lat":43.6452785,"lng":-79.4131849,"heading":-25.74,"pitch":"-1.34"},"rankings":{"Housing":19.7,"Crime":39.4,"Transit":73.9,"Shopping":88,"Health":33.1,"Entertainment":97.9,"Community":61.3,"Diversity":9.9,"Schools":64.8,"Employment":73.2},"irank":42,"urank":42},
To be clearer:
The keys are "HOOD","Housing","Crime","Shopping".
I want to get their values.
This will do it
Option Explicit
Sub GetInfo()
'"HOOD","Housing","Crime","Shopping"
Dim strURL As String, strJSON As String, http As Object, json As Object
strURL = "https://torontolife.com/wp-content/themes/sjm-underscores/inc/neighbourhoods/2015/compiled.json"
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strURL, False
http.send
strJSON = http.responseText
Set json = JsonConverter.ParseJson(strJSON)("features")
Dim i As Long, key As Variant
For i = 1 To json.count
For Each key In json(i)
Select Case True
Case key = "properties"
Dim a As Object, key2 As Variant
Set a = json(i)(key)
For Each key2 In a.Keys
Select Case key2
Case "HOOD"
Debug.Print "Hood" & " " & a(key2)
Case "rankings"
Dim b As Object
Set b = a(key2)
Debug.Print "Housing" & " : " & b("Housing")
Debug.Print "Crime" & " : " & b("Crime")
Debug.Print "Shopping" & " : " & b("Shopping")
End Select
Next key2
End Select
Next key
Next i
End Sub
Example output:
Notes:
If you examine the JSON structure you can see it is as follows (sample)
The information we want in the dictionary returned is within "features" so we can extract that initially with:
Set json = JsonConverter.ParseJson(strJSON)("features")
This yields a collection (see the "[" at the start) of dictionaries. Within those dictionaries, we are interested in whenever the key "properties" appears, as those hold the items of interest. We can use a Select Case statement to filter for that key:
Select Case True
Case key = "properties"
We then set that to a variable, which is again a dictionary:
Set a = json(i)(key)
From the JSON image we can see again that we are interested in specific keys: HOOD and rankings; in order to get the items of interest ("HOOD","Housing","Crime","Shopping") .
HOOD and rankings return different datatypes.
HOOD returns a string:
So we can directly access the required value with the associated key:
a(key2)
I have added Debug.Print "Hood" & " " & a(key2) into the code to make it clear for you but have dropped the "Hood" prefix for my run as looks cleaner, in my opinion, in output.
rankings returns a dictionary, see the "{":
So, if we initially set that to a variable:
Set b = a(key2)
We can avoid looping the keys and directly access via the keys of interest i.e.:
Debug.Print "Housing" & " : " & b("Housing")
Debug.Print "Crime" & " : " & b("Crime")
Debug.Print "Shopping" & " : " & b("Shopping")
I have added some descriptor text so make the output clearer.
You don't need any external converter to play around with json data. There is already a robust method out there. To run the script you don't even add anything to the reference library other than what you did for xmlhttp requests. To get the corresponding values you need to use . dot operator to call it's keys. However, in some cases you might find some contradictory names like Status,Ranking,Properties which are already available in vba built-in items so you have to handle them using CallByName function like I've done below. It's even easier (the usage of it) than pulling any item from html elements out of a regular webpage.
This is how you can get your required items:
Sub FetchJsonInfo()
Const URL As String = "https://torontolife.com/wp-content/themes/sjm-underscores/inc/neighbourhoods/2015/compiled.json"
Dim Http As New XMLHTTP60, SC As Object, elem As Object
Dim resobject As Object, post As Object, R&
Set SC = CreateObject("ScriptControl")
SC.Language = "JScript"
With Http
.Open "GET", URL, False
.send
Set resobject = SC.Eval("(" + .responseText + ")")
.abort
For Each post In resobject.features
Set elem = CallByName(post, "properties", VbGet)
R = R + 1: Cells(R, 1) = elem.HOOD
Cells(R, 2) = elem.rankings.Housing
Cells(R, 3) = elem.rankings.Crime
Cells(R, 4) = elem.rankings.Shopping
Next post
End With
End Sub
Reference to add to the library:
Microsoft XML, v6.0

Parse JSON/XML parameters from web API

This is a quick and dirty POC I have so far from other helpful Stack posts:
Public Function WebRequest(url As String) As String
Dim http As MSXML2.xmlhttp
Set http = CreateObject("MSXML2.ServerXMLHTTP")
http.open "GET", url, False
http.send
WebRequest = http.responseText
Set http = Nothing
End Function
Private Sub Command1_Click()
Dim http As MSXML2.xmlhttp
Dim result As String
Dim url As String
Dim productId As String
productId = "2"
url = "http://localhost:1111/api/products/" & productId
result = WebRequest(url)
MsgBox result
End Sub
This calls a simple web API and returns as expected. The response reads as:
{"Id":2,"Name":"Yo-yo","Category":"Toys","Price":3.75}
What is the best way to assign the parameters to variables for use within the rest of the app?
There is no "best" way to parse JSON, but there are several existing VB6 classes for doing so. There is nothing built into VB6 or in Windows you can use though, so there isn't any obvious choice to reach for first.
If you don't want to use an existing VB6 class or a 3rd party library then you could just "manually" do the parsing with your own code. As long as the JSON you expect is pretty simple that might be all you need.
Many pitfalls here but it works for your very simple case as long as no other data types are used, the strings never have quotes or escaped symbols, etc.:
Option Explicit
Private Sub Main()
Const SIMPLE_JSON As String = _
"{""Id"":2,""Name"":""Yo-yo"",""Category"":""Toys"",""Price"":3.75}"
Dim JsonItems() As String
Dim Collection As Collection
Dim I As Long
Dim Parts() As String
Dim Value As Variant
JsonItems = Split(Mid$(SIMPLE_JSON, 2, Len(SIMPLE_JSON) - 2), ",")
Set Collection = New Collection
For I = 0 To UBound(JsonItems)
Parts = Split(JsonItems(I), ":")
Parts(0) = Mid$(Parts(0), 2, Len(Parts(0)) - 2)
If Left$(Parts(1), 1) = """" Then
Value = Mid$(Parts(1), 2, Len(Parts(1)) - 2)
Else
Value = Val(Parts(1))
End If
Collection.Add Array(Parts(0), Value), Parts(0)
Next
With Collection
For I = 1 To .Count
Debug.Print .Item(I)(0); "="; .Item(I)(1)
Next
End With
End Sub
Result:
Id= 2
Name=Yo-yo
Category=Toys
Price= 3.75
The Val() function is used for the non-String values because it is locale blind (always uses the invariant locale, which JSON numbers should always be formatted for).

VBA input data in the Web field

I am coding vba to open the central bank's website and input the values ​​and extract the data, I usually do this on the mail site, bank of Brazil etc ...
() of the central bank
I can not give the input value via vba in the textbox I've already tried:
Ie.Document.all.Item("valueConverter").Innertext="1"
Ie.Document.getElementById("valueConverter").Value="1"
Ie.Document.getElementById("valueConverter")(0).Value="1"
Ie.Document.getElementByName("valueConverter").Value = "1"
The Elements of this site is this:
<Input type = "text" name = "valueConverter" maxlength = "17" size "20" value onkeypress = "return (MascaraMoeda (this, '.', ',', Event)
Does anyone know how?
tl;dr;
I cannot mark this as a duplicate as there is no accepted answer to where I posted an answer to a similar question.
Not sure of the protocol as simply posting a link in the comments doesn't mean it will be found again.
My full answer is here: Excel Web Query Submit Issues
To summarize:
You can use the bcb.gov.br Open Data Portal.
Send a request for a JSON response with the conversion rates from their Exchange rates – daily bulletins.
With the received response, amongst other methods, you can then:
Use the JSON Converter .basa and set the convert the response into a JSON object and work with that
Parse the response as a string with a regex to get the values
For brevity, I will give you just the second method here and you can view my other answer for both methods:
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