I am using the following codes:
Private Sub CommandButton1_Click()
Dim excelRange As Range
Dim jsonItems As New Collection
Dim jsonDictionary As New Dictionary
Dim jsonFileObject As New FileSystemObject
Dim jsonFileExport As TextStream
Dim i As Long
Dim cell As Variant
Set excelRange = Sheet1.Cells(3, 3).CurrentRegion
For i = 4 To excelRange.Rows.Count
jsonDictionary("ID") = Sheet1.Cells(i, 1)
jsonDictionary("Pass") = Sheet1.Cells(i, 2)
jsonDictionary("MN") = Sheet1.Cells(i, 3)
jsonDictionary("Email") = Sheet1.Cells(i, 4)
jsonItems.Add jsonDictionary
Set jsonDictionary = Nothing
Next i
MsgBox (JsonConverter.ConvertToJson(jsonItems, Whitespace:=0))
Set jsonFileExport = jsonFileObject.CreateTextFile(Application.GetSaveAsFilename(fileFilter:="Text Files (*.json), *.json"), True)
jsonFileExport.WriteLine (JsonConverter.ConvertToJson(jsonItems, Whitespace:=3))
I got JSON file in following format:
[
{
"id": "AA2478FV",
"PAss": "MAAS",
"MN": "9878965421",
"email": "",Abc#123
}]
But I need JSON in the following format:
{"b2b deatils":[{"id":"01AF2578T","pass":"N","MN":8789755654,"furdetails":[{"nameorg":
[{"emp":1,"itm_det":{"recmount":0}}]}]
How can I get this ?
Related
I try to read json array which return from RestResponse using following code , i am used RestClient to call POST method
Dim clientPI As RestClient = New RestClient("https://sampleurl")
Dim requestPI = New RestRequest(Method.POST)
requestPI.AddParameter("name", "Aravind")
requestPI.AddParameter("username", "aravind")
requestPI.AddParameter("password", "aravind123")
requestPI.AddParameter("id", "100")
Dim responsePI As RestResponse = clientPI.Execute(requestPI)
Dim StrReturnPI As JValue = responsePI.Content.ToString
Dim serPI As JObject = JObject.Parse(StrReturnPI)
Dim dataPI As List(Of JToken) = serPI.Children().ToList
For Each item As JProperty In dataPI
item.CreateReader()
Select Case item.Name
Case "result"
output += "Document_id:" + vbCrLf
For Each comment As JObject In item.Values
Dim u As String = comment("Document_id")
output += u + vbTab
Next
Case "Inv_Date"
output += "Inv_Date:" + vbCrLf
For Each msgDate As JObject In item.Values
Dim f As String = msgDate ("value")
output += f + vbTab
Next
Case "Inv_Number"
output += "Inv_Number:" + vbCrLf
For Each msg As JObject In item.Values
Dim f As String = msg("value")
output += f + vbTab
Next
End Select
Next
Sample Json
{{
"result": [
{
"Document_id": "598dce483b97c",
"file_name": "2022-04-04_09_13_14.847228.pdf",
"Inv_Date": {
"value": "15-Jul-2019",
},
"Inv_Number": {
"value": "1920021347",
}
}
]],
"status": "complete"
}}
From above code i can read only value from Document_id and file_name but cant read value from Inv_Date and Inv_Number.
Anyone help will be appreciated.
Thanks and regards
Aravind
First of all, sorry because I can't check against a proper vb.net ide actually so some typo can occur, but I think this may solution your problem:
Get the values inside the result case as the structure is defined that way
Case "result"
output += "Document_id:" + vbCrLf
For Each comment As JObject In item.Values
Dim u As String = comment("Document_id")
output += u + vbTab
Dim invDate As JObject = comment("Inv_Date")
Dim invNumber As JObject = comment("Inv_Number")
Dim invDateValue As String = invDate("value")
output += invDateValue + vbTab
Dim invNumberValue As String = invNumber("value")
output += invNumberValue + vbTab
Next
I have this Json data need to get the values on vb.net
{
"type": "push",
"targets": ["stream"],
"push": {
"type": "mirror",
"source_device_iden": "ujzp6Xr9A4asjyjskXPzu8",
"source_user_iden": "ujzp6Xr9A4a",
"client_version": 354,
"dismissible": true,
"icon": "ok",
"title": "test",
"body": "Hi",
"application_name": "WhatsApp",
"package_name": "com.whatsapp",
"notification_id": "1",
"notification_tag": "y9x5Q2YAI\/pqPhZwbaN6TpoW4eJhe0kAe0HfmWOQyWA=\n",
"conversation_iden": "{\"package_name\":\"com.whatsapp\",\"tag\":\"y9x5Q2YAI\\\/pqPhZwbaN6TpoW4eJhe0kAe0HfmWOQyWA=\\n\",\"id\":1}"
}
}
I tried this code it is return error
Dim json As String = TextBox1.Text
Dim ser As JObject = JObject.Parse(json)
Dim data As List(Of JToken) = ser.Children().ToList
For Each item As JProperty In data
item.CreateReader()
Select Case item.Name
Case "push"
For Each msg As JObject In item.Value
Dim tyep As String = msg("type")
Dim source As String = msg("source_device_iden")
Next
End Select
Next
System.InvalidCastException: 'Unable to cast object of type
'Newtonsoft.Json.Linq.JProperty' to type
'Newtonsoft.Json.Linq.JObject'.'
Dim json As String = TextBox1.Text
Dim ser As JObject = JObject.Parse(json)
Dim data As List(Of JToken) = ser.Children().ToList
For Each item As JProperty In data
item.CreateReader()
Select Case item.Name
Case "push"
For Each msg As JObject In item
Dim tyep As String = msg("type")
Dim source As String = msg("source_device_iden")
Next
End Select
Next
I have a curl command I was given and trying to convert and use it in .net. I have tried many different scenarios but this was the closest one I thought would work. Anyone know what I am doing wrong? the response back si saying invalid API Key
Curl COMMAND = https://api.com/api/v1/scores --data "token=YOUR_API_TOKEN"
Dim request As HttpWebRequest = HttpWebRequest.Create("https://api.com/api/v1/groups")
request.Proxy = Nothing
request.Method = "GET"
request.ContentType = "application/json"
request.Headers.Add("Authorization", "Basic " + Convert.ToBase64String(New ASCIIEncoding().GetBytes(String.Format("{0}={1}", "Token", personalaccesstoken))))
'create the response and reader
Dim Response As HttpWebResponse = request.GetResponse
Dim ResponseStream As System.IO.Stream = Response.GetResponseStream
'Create Stream reader
Dim StreamReader As New System.IO.StreamReader(ResponseStream)
Dim data As String = StreamReader.ReadToEnd
StreamReader.Close()
'get the data
jsonString = data.ToString.Replace("'", "''")
I ended up resolving this issue with the following code.
Dim request As HttpWebRequest = HttpWebRequest.Create(apiURI)
request.Proxy = Nothing
request.Method = "POST"
request.ContentType = "application/x-www-form-urlencoded"
Dim postData As String = "token=22222222222222222"
Dim encoding As ASCIIEncoding = New ASCIIEncoding()
Dim byte1 As Byte() = encoding.GetBytes(postData)
request.ContentLength = byte1.Length
Dim newStream As Stream = request.GetRequestStream()
newStream.Write(byte1, 0, byte1.Length)
Dim Response As HttpWebResponse = request.GetResponse
Dim ResponseStream As System.IO.Stream = Response.GetResponseStream
'Create Stream reader
Dim StreamReader As New System.IO.StreamReader(ResponseStream)
_jsonString = StreamReader.ReadToEnd
StreamReader.Close()
I have a problem with Newtonsoft.Json. I'm trying to parse JSON from a URL but I'm getting an error. Here is the JSON:
[
{
"ID": "0",
"Nome": "we",
"Data": "2013-09-16",
"Orario": "00:00:16",
"Prestazione": "dfg",
"Stato": "dfg",
"Numero_Telefono": "dfg"
},
{
"ID": "0",
"Nome": "fg",
"Data": "2013-09-26",
"Orario": "00:00:00",
"Prestazione": "",
"Stato": "",
"Numero_Telefono": ""
},
{
"ID": "1",
"Nome": "davide",
"Data": "2013-09-26",
"Orario": "00:00:16",
"Prestazione": "ds",
"Stato": "sd",
"Numero_Telefono": "3546"
}
]
Here is the code I am using:
Dim request As HttpWebRequest
Dim response As HttpWebResponse = Nothing
Dim reader As StreamReader
Try
request = DirectCast(WebRequest.Create("http://nhd.altervista.org/connectDb.php"), HttpWebRequest)
response = DirectCast(request.GetResponse(), HttpWebResponse)
reader = New StreamReader(response.GetResponseStream())
Dim rawresp As String
rawresp = reader.ReadToEnd()
Dim jResults As JObject = JObject.Parse(rawresp)
Dim results As List(Of JToken) = jResults.Children().ToList()
For Each item As JProperty In results
item.CreateReader()
MsgBox(item.Value("img")) ' because my tag in json is img
Next
Catch ex As Exception
Console.WriteLine(ex.ToString)
MsgBox(ex.ToString)
Finally
If Not response Is Nothing Then response.Close()
End Try
This is the error I receive when I try to parse the JSON:
Newtonsoft.Json.JsonReaderException: Error reading JObject from JsonReader. Current JsonReader item is not an object: StartArray. Path '', line 1, position 1.
Can you help me solve this?
You are getting this error because you are using JObject.Parse, which expects a single JSON object, but your JSON contains an array. To correct this, use JArray.Parse instead.
But, there is another problem: the rest of your code is not set up to handle the results correctly. Because your results are an array of objects, your For Each loop needs to be expecting JObject items, not JProperty items. Once you have each item, you can then get the properties from them as needed.
I am not sure what you were trying to do with the item.CreateReader() line, as you are not doing anything with its return value, and you don't seem to need anyway. Similarly, I am also confused with your MsgBox(item.Value("img")) line, because there is no "img" property anywhere in the JSON. So this will always be null.
Here is some corrected code which will parse the JSON and display all the properties for each object in the results. This should give you a starting point to work with.
Dim request As HttpWebRequest
Dim response As HttpWebResponse = Nothing
Dim reader As StreamReader
Try
request = DirectCast(WebRequest.Create("http://nhd.altervista.org/connectDb.php"), HttpWebRequest)
response = DirectCast(request.GetResponse(), HttpWebResponse)
reader = New StreamReader(response.GetResponseStream())
Dim rawresp As String
rawresp = reader.ReadToEnd()
Dim jResults As JArray = JArray.Parse(rawresp)
Dim results As List(Of JToken) = jResults.Children().ToList()
For Each item As JObject In results
Dim demo As String = ""
For Each prop As JProperty In item.Properties()
demo = demo + prop.Name + " = " + prop.Value.ToString() + vbCrLf
Next
MsgBox(demo)
Next
Catch ex As Exception
Console.WriteLine(ex.ToString)
MsgBox(ex.ToString)
Finally
If Not response Is Nothing Then response.Close()
End Try
I need to handle a JSON Object which is the response of XMLHTTPRequest in Excel VBA. I wrote the code below, but it doesn't work:
Dim sc As Object
Set sc = CreateObject("ScriptControl")
sc.Language = "JScript"
Dim strURL As String: strURL = "blah blah"
Dim strRequest
Dim XMLhttp: Set XMLhttp = CreateObject("msxml2.xmlhttp")
Dim response As String
XMLhttp.Open "POST", strURL, False
XMLhttp.setrequestheader "Content-Type", "application/x-www-form-urlencoded"
XMLhttp.send strRequest
response = XMLhttp.responseText
sc.Eval ("JSON.parse('" + response + "')")
I am getting the error Run-time error '429' ActiveX component can't create object in the line Set sc = CreateObject("ScriptControl")
Once we parsed the JSON Object, how do you access the values of the JSON Object?
P.S. My JSON Object sample: {"Success":true,"Message":"Blah blah"}
The code gets the data from nseindia site which comes as a JSON string in responseDiv element.
Required References
3 Class Module i have used
cJSONScript
cStringBuilder
JSON
(I have picked these class modules from here)
You may download the file from this link
Standard Module
Const URl As String = "http://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuote.jsp?symbol=ICICIBANK"
Sub xmlHttp()
Dim xmlHttp As Object
Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
xmlHttp.Open "GET", URl & "&rnd=" & WorksheetFunction.RandBetween(1, 99), False
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
Dim html As MSHTML.HTMLDocument
Set html = New MSHTML.HTMLDocument
html.body.innerHTML = xmlHttp.ResponseText
Dim divData As Object
Set divData = html.getElementById("responseDiv")
'?divData.innerHTML
' Here you will get a string which is a JSON data
Dim strDiv As String, startVal As Long, endVal As Long
strDiv = divData.innerHTML
startVal = InStr(1, strDiv, "data", vbTextCompare)
endVal = InStr(startVal, strDiv, "]", vbTextCompare)
strDiv = "{" & Mid(strDiv, startVal - 1, (endVal - startVal) + 2) & "}"
Dim JSON As New JSON
Dim p As Object
Set p = JSON.parse(strDiv)
i = 1
For Each item In p("data")(1)
Cells(i, 1) = item
Cells(i, 2) = p("data")(1)(item)
i = i + 1
Next
End Sub
I've had a lot of success with the following library:
https://github.com/VBA-tools/VBA-JSON
The library uses Scripting.Dictionary for Objects and Collection for Arrays and I haven't had any issues with parsing pretty complex json files.
As for more info on parsing json yourself, check out this question for some background on issues surrounding the JScriptTypeInfo object returned from the sc.Eval call:
Excel VBA: Parsed JSON Object Loop
Finally, for some helpful classes for working with XMLHTTPRequest, a little plug for my project, VBA-Web:
https://github.com/VBA-tools/VBA-Web
I know this is an old question but I've created a simple way to interact with Json from web requests. Where i've wrapped the web request as well.
Available here
You need the following code as a class module called Json
Public Enum ResponseFormat
Text
Json
End Enum
Private pResponseText As String
Private pResponseJson
Private pScriptControl As Object
'Request method returns the responsetext and optionally will fill out json or xml objects
Public Function request(url As String, Optional postParameters As String = "", Optional format As ResponseFormat = ResponseFormat.Json) As String
Dim xml
Dim requestType As String
If postParameters <> "" Then
requestType = "POST"
Else
requestType = "GET"
End If
Set xml = CreateObject("MSXML2.XMLHTTP")
xml.Open requestType, url, False
xml.setRequestHeader "Content-Type", "application/json"
xml.setRequestHeader "Accept", "application/json"
If postParameters <> "" Then
xml.send (postParameters)
Else
xml.send
End If
pResponseText = xml.ResponseText
request = pResponseText
Select Case format
Case Json
SetJson
End Select
End Function
Private Sub SetJson()
Dim qt As String
qt = """"
Set pScriptControl = CreateObject("scriptcontrol")
pScriptControl.Language = "JScript"
pScriptControl.eval "var obj=(" & pResponseText & ")"
'pScriptControl.ExecuteStatement "var rootObj = null"
pScriptControl.AddCode "function getObject(){return obj;}"
'pScriptControl.eval "var rootObj=obj[" & qt & "query" & qt & "]"
pScriptControl.AddCode "function getRootObject(){return rootObj;}"
pScriptControl.AddCode "function getCount(){ return rootObj.length;}"
pScriptControl.AddCode "function getBaseValue(){return baseValue;}"
pScriptControl.AddCode "function getValue(){ return arrayValue;}"
Set pResponseJson = pScriptControl.Run("getObject")
End Sub
Public Function setJsonRoot(rootPath As String)
If rootPath = "" Then
pScriptControl.ExecuteStatement "rootObj = obj"
Else
pScriptControl.ExecuteStatement "rootObj = obj." & rootPath
End If
Set setJsonRoot = pScriptControl.Run("getRootObject")
End Function
Public Function getJsonObjectCount()
getJsonObjectCount = pScriptControl.Run("getCount")
End Function
Public Function getJsonObjectValue(path As String)
pScriptControl.ExecuteStatement "baseValue = obj." & path
getJsonObjectValue = pScriptControl.Run("getBaseValue")
End Function
Public Function getJsonArrayValue(index, key As String)
Dim qt As String
qt = """"
If InStr(key, ".") > 0 Then
arr = Split(key, ".")
key = ""
For Each cKey In arr
key = key + "[" & qt & cKey & qt & "]"
Next
Else
key = "[" & qt & key & qt & "]"
End If
Dim statement As String
statement = "arrayValue = rootObj[" & index & "]" & key
pScriptControl.ExecuteStatement statement
getJsonArrayValue = pScriptControl.Run("getValue", index, key)
End Function
Public Property Get ResponseText() As String
ResponseText = pResponseText
End Property
Public Property Get ResponseJson()
ResponseJson = pResponseJson
End Property
Public Property Get ScriptControl() As Object
ScriptControl = pScriptControl
End Property
Example Usage (from ThisWorkbook):
Sub Example()
Dim j
'clear current range
Range("A2:A1000").ClearContents
'create ajax object
Set j = New Json
'make yql request for json
j.request "https://query.yahooapis.com/v1/public/yql?q=show%20tables&format=json&callback=&diagnostics=true"
'Debug.Print j.ResponseText
'set root of data
Set obj = j.setJsonRoot("query.results.table")
Dim index
'determine the total number of records returned
index = j.getJsonObjectCount
'if you need a field value from the object that is not in the array
'tempValue = j.getJsonObjectValue("query.created")
Dim x As Long
x = 2
If index > 0 Then
For i = 0 To index - 1
'set cell to the value of content field
Range("A" & x).value = j.getJsonArrayValue(i, "content")
x = x + 1
Next
Else
MsgBox "No items found."
End If
End Sub