I am parsing my JSON list everyday to my Excel spreadsheet. It is a list of around 400-500 user info and everyday it is being updated. Now because i don't want to parse the same list everyday, i just need to locate the new objects that are added to the JSON and comparing it with the existing parsed list in Excel. New objects will be added if not found. This is my code below:
Private Sub populate_Click()
Dim http As Object, JSON As Object, Item As Variant
Dim i As Integer
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "http://controlpanel.verio/rest/reports?errorMessages=null", False
http.send
Dim jsnStr As Object
Set jsnStr = ParseJson(http.responseText)
'Fetching data
i = 3
For Each Item In jsnStr("results")(1)("results")
Dim findy As Variant
findy = Item(4)
Columns("B:B").Select
Set cell = Selection.Find(What:=findy, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If cell Is Nothing Then
'do it something
Sheets(1).Cells(i, 1).Value = Item(3)
Sheets(1).Cells(i, 2).Value = Item(4)
Sheets(1).Cells(i, 5).Value = Item(18)
Sheets(1).Cells(i, 6).Value = Item(6)
Sheets(1).Cells(i, 7).Value = Item(7)
Sheets(1).Cells(i, 8).Value = Item(8)
Sheets(1).Cells(i, 9).Value = Item(5)
Sheets(1).Cells(i, 11).Value = Item(20)
i = i + 1
Else
'do it another thing
End If
Next
Set JSON = Nothing
Set http = Nothing
End Sub
I am not receiving any error but nothing is changed or updated from the excel list.
What should I correct in the below code?
Related
I built a VBA code in order to obtain data from Google Books API by entering the ISBN code of a book that I scanned previously with a bar scanner app by using my mobile phone.
With VBA-JSON library everything seems ok, but I have still one object that I cannot import.
The JSON file that I use to check if the code works is this:
https://www.googleapis.com/books/v1/volumes?q=isbn:9780553897852
And this is the code I use now to pick the data:
Public Sub exceljson()
'Error message if active cell is empty
If ActiveCell.Value = 0 Then
MsgBox "Select cell with ISBN", vbExclamation
Exit Sub
End If
'Error message if there is no match
On Error GoTo ErrMsg
Dim http As Object, JSON As Object, i As Integer, subitem As Object
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://www.googleapis.com/books/v1/volumes?q=isbn:" & ActiveCell.Value, False
http.send
Set JSON = ParseJson(http.responseText)
i = ActiveCell.Row
For Each Item In JSON("items")
Set subitem = Item("volumeInfo")
Sheets(1).Cells(i, ActiveCell.Column + 1).Value = subitem("publishedDate")
Sheets(1).Cells(i, ActiveCell.Column + 2).Value = subitem("title")
Sheets(1).Cells(i, ActiveCell.Column + 3).Value = subitem("subtitle")
Sheets(1).Cells(i, ActiveCell.Column + 4).Value = subitem("pageCount")
'To obtain ISBN-10 and ISBN-13
j = 5
For Each Child In subitem("industryIdentifiers")
Sheets(1).Cells(i, ActiveCell.Column + j).Value = Child("identifier")
j = j + 1
Next
i = i + 1
'To end with success
Next
MsgBox ("Process complete"), vbInformation
Exit Sub
'To en with an error message
ErrMsg:
MsgBox ("No match obtained"), vbCritical
End Sub
This is the resulted EXCEL sheet I made
Actually I have the fields: year of publication, title, subtitle, pages, ISBN-10, ISBN-13 presented in the subsequent cells of the ActiveCell I write the ISBN.
However I have no idea of how to collect data from "authors" array.
Is the only field I miss of the data so I really appreciate if you could help me.
Thanks in advance.
The following shows the correct path to the author. The {} indicates dictionary accessed by key and the [] indicates collection accessed by index. Note that the 0 index base in the image is actually a 1 base for the library used.
Option Explicit
Public Sub GetInfo()
Const URL As String = "https://www.googleapis.com/books/v1/volumes?q=isbn:9780553897852"
Dim json As Object
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
Set json = JsonConverter.ParseJson(.responseText)
End With
Debug.Print json("items")(1)("volumeInfo")("authors")(1)
End Sub
You can also view that path here:
With your logic you would need
Option Explicit
Public Sub GetInfo()
Const URL As String = "https://www.googleapis.com/books/v1/volumes?q=isbn:9780553897852"
Dim json As Object
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
Set json = JsonConverter.ParseJson(.responseText)
End With
'Debug.Print json("items")(1)("volumeInfo")("authors")(1)
Dim item As Object, item2 As Variant, subItem As Object, r As Long, c As Long
For Each item In json("items")
Set subItem = item("volumeInfo")
If subItem.Exists("authors") Then
r = r + 1: c = 1
For Each item2 In subItem("authors")
ActiveSheet.Cells(r, c) = item2
c = c + 1
Next
End If
Next
End Sub
Looking at the data from the webpage you're retrieving from, "authors" looks like a subitem of Item("volumeInfo"). If "authors" is reading as an array, you could pull it into a cell using
Sheets(1).Cells(i, ActiveCell.Column + 5).Value = Join(subitem("authors"),",")
Or if it's just a string then you could use
Sheets(1).Cells(i, ActiveCell.Column + 5).Value = subitem("authors")
And then make j = 6 to prevent overwriting the output.
Im trying to run the following code but I am getting a type mismatch error:
Public Sub exceljson()
Dim http As Object, JSON As Object, i As Integer
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://wex.nz/api/3/ticker/btc_usd-ltc_usd", False
http.Send
Set JSON = ParseJson(http.responseText)
i = 2
For Each Item In JSON
Sheets(1).Cells(i, 2).Value = Item("high")
Sheets(1).Cells(i, 3).Value = Item("low")
i = i + 1
Next
MsgBox ("complete")
End Sub
The example code below worked fine when I was using it:
Public Sub exceljson()
Dim http As Object, JSON As Object, i As Integer
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "http://jsonplaceholder.typicode.com/users", False
http.Send
Set JSON = ParseJson(http.responseText)
i = 2
For Each Item In JSON
Sheets(1).Cells(i, 1).Value = Item("id")
Sheets(1).Cells(i, 2).Value = Item("name")
Sheets(1).Cells(i, 3).Value = Item("username")
Sheets(1).Cells(i, 4).Value = Item("email")
Sheets(1).Cells(i, 5).Value = Item("address")("city")
Sheets(1).Cells(i, 6).Value = Item("phone")
Sheets(1).Cells(i, 7).Value = Item("website")
Sheets(1).Cells(i, 8).Value = Item("company")("name")
i = i + 1
Next
MsgBox ("complete")
End Sub
I'm not sure what the difference between the two sites is. Any help would be greatly appreciated.
You need to examine the structure of the JSON more closely.
Because you chose to not specifically declare your Item variable, it gets implicitly declared as a Variant (which is OK in this instance).
In your first macro, the Item is a String so you need to reference that as a key.
In your second macro, the Item will be a Dictionary object, so you can reference it the way you did.
So in your 1st macro, you need something like:
For Each Item In JSON
Sheets(1).Cells(i, 2).Value = JSON(Item)("high")
Sheets(1).Cells(i, 3).Value = JSON(Item)("low")
i = i + 1
Next
I have an issue with understanding Excel VBA: Parsed JSON Object Loop.
I need a solution on the below code:
Sub getPricesOnReport()
Dim url As String: url = "http://statistics.mla.com.au/ReportApi/RunReport?ReportGuid=70587516-e17a-4065-a8aa-e3fe4c512159&FromDate=13%2F03%2F2017&ToDate=18%2F03%2F2017"
Dim httpRequest As Object: Set httpRequest = CreateObject("MSXML2.XMLHttp")
Dim httpResponse As Object
Dim scriptControl As Object: Set scriptControl = createObject("MSScriptControl.ScriptControl")
Dim XDOM As ListObject
scriptControl.Language = "JScript"
httpRequest.Open "GET", url, False
httpRequest.send
Set httpResponse = scriptControl.eval("(" + httpRequest.responseText + ")")
With Sheets("MLA")
If httpResponse.ResponseStatus <> "OK" Then
MsgBox "Error in Response"
Else
Cells(3, 2).Value = httpResponse.ResponseDate
Cells(3, 3).Value = httpResponse.ResponseHeader
Cells(3, 4).Value = httpResponse.ResponseStatus
Cells(3, 5).Value = httpResponse.ResponseDisclaimer
'Cells(4, 2).Value = httpResponse.returnValue '
End If
End With
End Sub
I am getting an error for the code
Cells(4, 2).Value = httpResponse.returnValue
though the object is available.
PFB image:
How do i modify the code to access the data?
In this case, Capitalization matters!
ReturnValue needs to be capitalized properly.
It may be defaulting to a "small r" when you type ReturnValue if there are other references to returnValue. (VBA is trying to be helpful by correcting the word to how you typed it before!)
In the VBA Editor:
hit Ctrl+H.
Enter ReturnValue for both Find What and Replace With.
Make sure Current Project is selected, and that Match Case is unchecked.
Click Replace All
Every occurrence of the word will be changed to the correct capitalization.
I would like to display the following variables from a JSON-request; "time", "open", "high", "low", "close", "volumefrom", "volumeto" in respectively the following columns B, C, D, E, F, G and H.
The request:
https://min-api.cryptocompare.com/data/histoday?fsym=BTC&tsym=USD&limit=60&aggregate=3&e=CCCAGG
So, I would like to see for example the values of "open" located in C2:C51.
I wrote the following macro:
Sub OHLCdata()
Dim strURL As String
Dim strJSON As String
Dim strCurrency As String
Dim strLength As Integer
Dim i As Integer
Dim http As Object
strURL = "https://min-api.cryptocompare.com/data/histoday?fsym=" & strTicker & "&tsym=" & strCurrency & "&limit=" & strLength & "&aggregate=3&e=CCCAGG"
strTicker = Range("A2")
strCurrency = Range("A3")
strLength = Range("A4")
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strURL, False
http.Send
strJSON = http.responsetext
Set JSON = JsonConverter.ParseJson(strJSON)
i = 2
For Each Item In JSON("DATA")
Sheets(1).Cells(i, 1).Value = Item("time")
Sheets(1).Cells(i, 2).Value = Item("open")
Sheets(1).Cells(i, 3).Value = Item("high")
Sheets(1).Cells(i, 4).Value = Item("low")
Sheets(1).Cells(i, 5).Value = Item("close")
Sheets(1).Cells(i, 6).Value = Item("volumefrom")
Sheets(1).Cells(i, 7).Value = Item("volumeto")
i = i + 1
Next
End Sub
Unfortunately, the macro doesn't work as debugging shows that there is an error in the following line:
For Each Item In JSON("DATA")
However, I need to refer to ("Data") right?
{"Response":"Success","Type":100,"Aggregated":true,**"Data"**:[{"time":1493769600,"close":1507.77,"high":1609.84,"low":1424.05,"open":1445.93,"volumefrom":338807.89999999997,"volumeto":523652428.9200001},
Can anyone explain to me what I am doing wrong? Thanks in advance,
Can anyone explain to me what I am doing wrong?
You are close:
I suspect you probably did a copy/paste on the JSON parser rather than downloading the *.bas file and importing it. If you copied the file and then pasted it into a module, you would see the line Attribute VB_Name = "JsonConverter" Although legal in the .bas file, it is not in a module, hence the *"compile error: invalid inside procedure." * error message.
You create strURL before you define the variables that are included. Therefore the variables will be blank
Your column numbers are off when you write the results, so it will start in column A instead of B.
You fail to declare some of your variables.
Since JSON is a dictionary type object, the key will be case sensitive (unless you declare it to be otherwise). Hence DATA and Data are two different keys. You need to use Data.
Here is your code with the changes; and don't forget to import the .bas file and don't copy/paste.
Option Explicit
Sub OHLCdata()
Dim strURL As String
Dim strJSON As String
Dim strCurrency As String
Dim strLength As Integer
Dim strTicker As String
Dim i As Integer
Dim http As Object
Dim JSON As Dictionary, Item As Dictionary
strTicker = Range("A2")
strCurrency = Range("A3")
strLength = Range("A4")
strURL = "https://min-api.cryptocompare.com/data/histoday?fsym=" & strTicker & "&tsym=" & strCurrency & "&limit=" & strLength & "&aggregate=3&e=CCCAGG"
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strURL, False
http.Send
strJSON = http.responsetext
Set JSON = JsonConverter.ParseJson(strJSON)
i = 2
For Each Item In JSON("Data")
Sheets(1).Cells(i, 2).Value = Item("time")
Sheets(1).Cells(i, 3).Value = Item("open")
Sheets(1).Cells(i, 4).Value = Item("high")
Sheets(1).Cells(i, 5).Value = Item("low")
Sheets(1).Cells(i, 6).Value = Item("close")
Sheets(1).Cells(i, 7).Value = Item("volumefrom")
Sheets(1).Cells(i, 8).Value = Item("volumeto")
i = i + 1
Next
End Sub
Note: With regard to the Attribute line visible in the bas file if you open it in a text editor, you may refer to Chip Pearson's article on Code Attributes For The VBA Object Browser. It is generally considered bad form to refer to an external link, as they may disappear. However, I could not find a good discussion here on SO. If I have missed it, someone please comment and I will edit this.
You may get JSON data into arrays and output as shown in the example code below. Import JSON.bas module into the VBA project for JSON processing.
Option Explicit
Sub OHLCdata()
Dim sJSONString As String
Dim vJSON As Variant
Dim sState As String
Dim aData()
Dim aHeader()
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://min-api.cryptocompare.com/data/histoday?fsym=BTC&tsym=USD&limit=60&aggregate=3&e=CCCAGG", False
.send
sJSONString = .responseText
End With
JSON.Parse sJSONString, vJSON, sState
vJSON = vJSON("Data")
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
Here is the output for me:
BTW, the similar approach applied in other answers.
After running my vba script for the purpose of parsing data from a webpage I could see that it shows "object required" error. I can see the desired data in the msgbox which is set before the error causing line. As i haven't worked with json format yet, I can't make the execution successful. Any help would be appreciated. Here is what i'm up to:
Sub JsonData()
Dim http As New MSXML2.XMLHTTP60
Dim PostData As String, JSONa As Object, ele As Object
PostData = "region=US&latitude=61.7958256&longitude=-148.8045856&location=Sutton-Alpine%2C%20AK&source=US-STANDALONE&radius=25&pageNumber=1&pageSize=10&sortBy=&industryFilter=340&serviceFilter=550,90"
With http
.Open "GET", "https://proadvisorservice.intuit.com/v1/search?" & PostData, False
.setRequestHeader "Content-Type", "application/json; charset=utf-8"
.setRequestHeader "Accept", "application/json;version=1.1.0"
.send
Set JSONa = JsonConverter.ParseJson(.responseText)
End With
MsgBox http.responseText
For Each ele In JSONa
i = i + 1
Cells(i, 1).Value = ele("firstName")
Cells(i, 2).Value = ele("lastName")
Cells(i, 3).Value = ele("city")
Next ele
End Sub
The search results are VBA.Collection where each itemof this collection contains then another Scripting.Dictionary. Hope what you ask for is the following. HTH
Dim results As VBA.Collection
Set results = JSONa("searchResults")
Dim result As Scripting.Dictionary
For Each result In results
i = i + 1
Cells(i, 1).Value = result("firstName")
Cells(i, 2).Value = result("lastName")
Cells(i, 3).Value = result("city")
Next result