I use FIXER.IO popular API in a VBA to get exchange rates into some cells of my worksheet named USD, CNY, INR etc.
Fixer.io API was returning a text format giving the rates I needed.
As of March 6th 2018, the legacy Fixer API (api.fixer.io) was deprecated and changed into a new version that requires an API Access Key (got it upon registration) but only returns a JSON file. If I call the url:
http://data.fixer.io/api/latest?access_key=XXXXXXXXXXXX&symbols=USD,CNY,INR,THB,SGD,AUD
I get this JSON in return:
{"success":true,"timestamp":1523343843,"base":"EUR","date":"2018-04-10","rates":{"USD":1.231986,"CNY":7.757563,"INR":79.980529,"THB":38.462602,"SGD":1.614924,"AUD":1.592345}}
How can I parse the exchange values in my Excel variables (USD, CNY ...) ?
I tried to look around but my very limited programming skill did not help me to adapt any solution. Please give a "for dummy" reply :)
Thanks for any help provided
Regards
Marco
Take a look at the below example. Import JSON.bas module into the VBA project for JSON processing.
Option Explicit
Sub Test()
Dim sJSONString As String
Dim vJSON
Dim sState As String
Dim aData()
Dim aHeader()
' Retrieve data
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "http://data.fixer.io/api/latest?access_key=209f86f5304e0043a0879d8cb45c9c10&symbols=USD,CNY,INR,THB,SGD,AUD", False
.Send
sJSONString = .ResponseText
End With
' Parse JSON response
JSON.Parse sJSONString, vJSON, sState
' Refer to target dictionary containing rates
Set vJSON = vJSON("rates")
' Access to each item in dictionary
Debug.Print vJSON("USD")
Debug.Print vJSON("CNY")
Debug.Print vJSON("INR")
Debug.Print vJSON("THB")
Debug.Print vJSON("SGD")
Debug.Print vJSON("AUD")
' Convert to array and output to worksheet
JSON.ToArray vJSON, aData, aHeader
With Sheets(1)
.Cells.Delete
.Cells.WrapText = False
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
End Sub
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
The output for me as follows:
BTW, the similar approach applied in other answers.
Related
Im using an API to pull data to Excel and JSON parsing to format the data. I have 2 sites from where to get this data. 1 is smaller database with 3000 lines but the other is bigger with hunderds of thousands. Working with the smaller one I get no error and everything works fine but using the same code on bigger database everything juts kind of crashes/hangs up forever.
Code I'm using is surely very faulty and I was told I'm using too many parsings but I'm new to this so can't really figure it out right now.
Code I'm using:
Option Explicit
Sub Times()
Dim sJSONString As String
Dim vJSON
Dim sState As String
Dim aData()
Dim aHeader()
Dim vResult
Dim sName
Dim authKey As String
authKey = "my_auth_key"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://my_site_url", True
.SetRequestHeader "Authorization", "Bearer " & authKey
.send
Do Until .readyState = 4: DoEvents: Loop
sJSONString = .responseText
End With
JSON.Parse sJSONString, vJSON, sState
If sState = "Error" Then
MsgBox "Invalid JSON"
End
End If
vResult = vJSON("data")
JSON.ToArray vResult, aData, aHeader
With ThisWorkbook.Sheets(1)
.Cells.Delete
.Cells.WrapText = False
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
vJSON.Remove "data"
Application.DisplayAlerts = False
With ThisWorkbook.Sheets
Do Until .Count = 1
.Item(.Count).Delete
Loop
End With
Application.DisplayAlerts = True
For Each sName In vJSON
If IsArray(vJSON(sName)) Or IsObject(vJSON(sName)) Then
JSON.ToArray vJSON(sName), aData, aHeader
With ThisWorkbook.Sheets.Add
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
vJSON.Remove sName
End If
Next
JSON.ToArray vJSON, aData, aHeader
JSON.Parse sJSONString, vJSON, sState
JSON.Flatten vJSON, vResult
JSON.ToArray vResult, aData, aHeader
MsgBox "Completed"
End Sub
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Maybe by simplifying and correcting the code my bigger database macro would work as well.
I'm trying to extract JSON data into Excel sheet as table by using the following code.
Sub test()
Dim httpObject As Object
Set httpObject = CreateObject("MSXML2.XMLHTTP")
sURL = "https://www.nseindia.com/live_market/dynaContent/live_watch/stock_watch/foSecStockWatch.json"
sRequest = sURL
httpObject.Open "GET", sRequest, False
httpObject.send
sGetResult = httpObject.responseText
Dim oJSON As Object
Set oJSON = JsonConverter.ParseJson(sGetResult)
i = 2
For Each sItem In oJSON
dItemString = oJSON(sItem)("symbol")
sItemValue = oJSON(sItem)("open")
vItemValue = oJSON(sItem)("high")
xItemValue = oJSON(sItem)("low")
Cells(i, 1) = dItemString
Cells(i, 2) = sItemValue
Cells(i, 3) = vItemValue
Cells(i, 4) = xItemValue
i = i + 1
Next
End Sub
However, I'm getting the below error!
Why I'm getting this error? Kindly advise
First of all you need to examine the structure of the JSON response, using any online JSON viewer (e. g. http://jsonviewer.stack.hu/), where you can see that your JSON object contains data array, and several properties with scalar values:
Going further there are objects within data array, each of them contains some properties that can be populated in rows on the worksheet:
Here is VBA example showing how that values could be retrieved. Import JSON.bas module into the VBA project for JSON processing.
Option Explicit
Sub Test()
Dim sJSONString As String
Dim vJSON
Dim sState As String
Dim aData()
Dim aHeader()
Dim vResult
' Retrieve JSON content
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/stock_watch/foSecStockWatch.json", True
.send
Do Until .readyState = 4: DoEvents: Loop
sJSONString = .responseText
End With
' Parse JSON sample
JSON.Parse sJSONString, vJSON, sState
If sState = "Error" Then MsgBox "Invalid JSON": End
' Convert raw JSON to 2d array and output to worksheet #1
JSON.ToArray vJSON("data"), aData, aHeader
With ThisWorkbook.Sheets(1)
.Cells.Delete
.Cells.WrapText = False
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
MsgBox "Completed"
End Sub
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
The output for data array for me is as follows:
BTW, the similar approach applied in other answers.
I pasted your code into a test module and then imported the JsonConverter as an additional module in my empty workbook. The error you're getting is likely because you need to add the "Microsoft Scripting Runtime" library to your workbook. In the VBE go to the Tools-->References... menu and then scroll down and put a check mark next to the library. After doing this, your code parsed the JSON without issue.
However it did fail in your loop.
I highly recommend that you use Option Explicit at the top of your module. The variable types you think you're using (because I see you're attempting to use Hungarian notation) are not the types of the actual data necessarily. My suggestion is to use descriptive names for the variables to avoid confusion. Additionally, you should be looping on the oJSON("data") structure (which is a Collection by the way). Here is my suggestions put into practice:
Option Explicit
Sub test()
Dim httpObject As Object
Set httpObject = CreateObject("MSXML2.XMLHTTP")
Dim sURL As String
sURL = "https://www.nseindia.com/live_market/dynaContent/" & _
"live_watch/stock_watch/foSecStockWatch.json"
Dim sRequest As String
sRequest = sURL
httpObject.Open "GET", sRequest, False
httpObject.send
Dim sGetResult As String
sGetResult = httpObject.responseText
Dim oJSON As Object
Set oJSON = JsonConverter.ParseJson(sGetResult)
Dim i As Long
i = 2
Dim dataItem As Variant
Dim symbolName As String
Dim openValue As Double
Dim highValue As Double
Dim lowValue As Variant
For Each dataItem In oJSON("data")
symbolName = dataItem("symbol")
openValue = dataItem("open")
highValue = dataItem("high")
lowValue = dataItem("low")
Cells(i, 1) = symbolName
Cells(i, 2) = openValue
Cells(i, 3) = highValue
Cells(i, 4) = lowValue
i = i + 1
Next
End Sub
The json I am parsing is at this URL https://reqres.in/api/users?page=2. I am using the following code to parse it.
Option Explicit
Sub Test_LateBinding()
Dim objRequest As Object
Dim strUrl As String
Dim blnAsync As Boolean
Dim strResponse As String
Set objRequest = CreateObject("MSXML2.XMLHTTP")
strUrl = "https://reqres.in/api/users?page=2"
blnAsync = True
With objRequest
.Open "GET", strUrl, blnAsync
.SetRequestHeader "Content-Type", "application/json"
.Send
'spin wheels whilst waiting for response
While objRequest.readyState <> 4
DoEvents
Wend
strResponse = .ResponseText
End With
Debug.Print strResponse
End Sub
I can successfully get the json into the strResponse variable. But lets say I want a variable that is equal to "Eve" which is under first name in the json string. How can I set a variable firstName = "Eve" from that json string.
If you need to work with JSON in VBA then I would recommend using this library:
https://github.com/VBA-tools/VBA-JSON
A simple example using that library:
Public Sub Tester()
Dim http As Object, JSON As Object, d
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://reqres.in/api/users?page=2", False
http.SetRequestHeader "Content-Type", "application/json"
http.Send
Set JSON = ParseJson(http.responseText)
For Each d In JSON("data")
Debug.Print d("id"), d("first_name")
Next
End Sub
Here is VBA example showing how that values could be retrieved. Import JSON.bas module into the VBA project for JSON processing.
Option Explicit
Sub Test()
Dim sJSONString As String
Dim vJSON
Dim sState As String
Dim aItems
Dim firstName As String
Dim oItem
Dim i As Long
Dim aData()
Dim aHeader()
' Retrieve JSON content
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://reqres.in/api/users?page=2", True
.send
Do Until .readyState = 4: DoEvents: Loop
sJSONString = .responseText
End With
' Parse JSON sample
JSON.Parse sJSONString, vJSON, sState
If sState = "Error" Then
MsgBox "Invalid JSON"
End
End If
' Process objects in array
' Get 'data' array of objects, there is no Set keyword for arrays
aItems = vJSON("data")
' Access specific item 'first_name' property
firstName = aItems(0)("first_name")
Debug.Print firstName
' Access each item 'first_name' property
For Each oItem In aItems
firstName = oItem("first_name")
Debug.Print firstName
Next
' Convert array of objects to 2d array
JSON.ToArray aItems, aData, aHeader
' Access each item element with index 1, which corresponds to 'first_name' property
For i = 0 To UBound(aData, 1)
firstName = aData(i, 1)
Debug.Print firstName
Next
' Output 2d array to first worksheet
With ThisWorkbook.Sheets(1)
.Cells.Delete
.Cells.WrapText = False
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
MsgBox "Completed"
End Sub
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
BTW, the similar approach applied in other answers.
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 4 years ago.
Improve this question
I want to import the data from this link https://api.cartolafc.globo.com/time/slug/umo/16 (the last two references, "umo" and "16" are dynamic) to a spreedsheet, linking the references to the cells.
I have no knowledgment about api or JSON. Is there a "simple" way to do this?
First of all you need to examine the structure of the JSON response, using any online JSON viewer (e. g. http://jsonviewer.stack.hu/), where you can see that your JSON object contains atletas array, clubes, posicoes, status, time objects, and several properties with scalar values:
Going further there are objects within atletas array, each of them contains some properties that can be populated on the worksheet:
Here is VBA example showing how that values could be retrieved. Import JSON.bas module into the VBA project for JSON processing.
Option Explicit
Sub Test()
Dim sJSONString As String
Dim vJSON
Dim sState As String
Dim aData()
Dim aHeader()
Dim vResult
Dim sName
' Retrieve JSON content
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://api.cartolafc.globo.com/time/slug/umo/16", True
.send
Do Until .readyState = 4: DoEvents: Loop
sJSONString = .responseText
End With
' Parse JSON sample
JSON.Parse sJSONString, vJSON, sState
If sState = "Error" Then
MsgBox "Invalid JSON"
End
End If
' Example of processing single property
' Get 'atletas' array of objects, there is no Set keyword for arrays
vResult = vJSON("atletas")
'' Optional get 'clubes' object of objects, Set keyword used for objects represented by dictionaries
'' Set vResult = vJSON("clubes")
' Convert to 2d array
JSON.ToArray vResult, aData, aHeader
' Output 2d array to first worksheet
With ThisWorkbook.Sheets(1)
.Cells.Delete
.Cells.WrapText = False
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
' Remove 'atletas' array from root object
vJSON.Remove "atletas"
' Remove all worksheets but the first
Application.DisplayAlerts = False
With ThisWorkbook.Sheets
Do Until .Count = 1
.Item(.Count).Delete
Loop
End With
Application.DisplayAlerts = True
' Example of processing multiply properties on separate worksheets
' Processing all the rest of objects and arrays
For Each sName In vJSON
' Check if the property is array or object
If IsArray(vJSON(sName)) Or IsObject(vJSON(sName)) Then
' Convert to 2d array
JSON.ToArray vJSON(sName), aData, aHeader
' Output 2d array to worksheet
With ThisWorkbook.Sheets.Add ' Create new worksheet for output
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
' Remove output object from root object
vJSON.Remove sName
End If
Next
' Processing all the rest of properties with scalar values which remain in root object
' Convert root object to 2d array
JSON.ToArray vJSON, aData, aHeader
' Output 2d array to worksheet
With ThisWorkbook.Sheets.Add ' Create new worksheet for output
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
' Or the whole JSON structure could be flattened and output to worksheet
' Parse JSON sample
JSON.Parse sJSONString, vJSON, sState
' Flatten JSON
JSON.Flatten vJSON, vResult
' Convert flattened JSON to 2d array
JSON.ToArray vResult, aData, aHeader
' Output 2d array to worksheet
With ThisWorkbook.Sheets.Add ' Create new worksheet for output
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
MsgBox "Completed"
End Sub
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
The output for atletas array for me is as follows:
BTW, the similar approach applied in other answers.
Pretty new to this so bear with me. I am needing to extract marker coordinates from an embedded google map - an example link is http://www.picknpay.co.za/store-search and I want to extract all marker positions generated in the map on search. Considered using services such as ParseHub but before going that route I thought I'd give a shot through SO/myself.
There has to be an easier way of finding the coordinates for markers stored in the map than manually going through them all and searching for their coordinates individually?
The webpage source HTML by the link provided http://www.picknpay.co.za/store-search doesn't contain the necessary data, it uses AJAX. The website http://www.picknpay.co.za has a sorta API available. Response is returned in JSON format. Navigate the page e. g. in Chrome, then open Developer Tools window (F12), Network tab, reload (F5) the page and examine logged XHRs. Most relevant data is JSON string returned by the URL:
http://www.picknpay.co.za/picknpay/json/picknpay/en/modules/store_finder/findStores.json
You may use the below VBA code to retrieve info as described above. Import JSON.bas module into the VBA project for JSON processing.
Option Explicit
Sub Scrape_picknpay_co_za()
Dim sResponse As String
Dim sState As String
Dim vJSON As Variant
Dim aRows() As Variant
Dim aHeader() As Variant
' Retrieve JSON data
XmlHttpRequest "POST", "http://www.picknpay.co.za/picknpay/json/picknpay/en/modules/store_finder/findStores.json", "", "", "", sResponse
' Parse JSON response
JSON.Parse sResponse, vJSON, sState
If sState <> "Array" Then
MsgBox "Invalid JSON response"
Exit Sub
End If
' Convert result to arrays for output
JSON.ToArray vJSON, aRows, aHeader
' Output
With ThisWorkbook.Sheets(1)
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aRows
.Columns.AutoFit
End With
MsgBox "Completed"
End Sub
Sub XmlHttpRequest(sMethod As String, sUrl As String, arrSetHeaders, sFormData, sRespHeaders As String, sContent As String)
Dim arrHeader
'With CreateObject("Msxml2.ServerXMLHTTP")
' .SetOption 2, 13056 ' SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
With CreateObject("MSXML2.XMLHTTP")
.Open sMethod, sUrl, False
If IsArray(arrSetHeaders) Then
For Each arrHeader In arrSetHeaders
.SetRequestHeader arrHeader(0), arrHeader(1)
Next
End If
.send sFormData
sRespHeaders = .GetAllResponseHeaders
sContent = .responseText
End With
End Sub
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
The output for me is as follows:
BTW, the similar approach applied in other answers.