There are plenty of JSON parsers and even combined parser/serializers here in the CodeBank and elsewhere. There are even a few "SAX" style parsers for rapidly processing JSON input when they are huge or you have tons of JSON docs to process.
now add the 2 items below to the main form1. save the project to a folder.
place JOSON.txt in the same folder.
now run and click the button.
Code:
Private Sub Command1_Click()
Dim Result As String
Result = ReadTextFile(App.Path & "\JOSON.txt")
Dim p As Object
Set p = mdJson.JsonParseObject(Result)
If p Is Nothing Then
Exit Sub
End If
VSFActions.Rows = 0
Debug.Print JsonValue(p, "data/cf")
Debug.Print JsonValue(p, "data/denominazione")
Debug.Print JsonValue(p, "data/dettaglio/rea")
Debug.Print JsonValue(p, "data/gps/coordinates").Count
Debug.Print JsonValue(p, "data/gps/coordinates/0")
Debug.Print JsonValue(p, "data/gps/coordinates/1")
End Sub
Code:
Public Function ReadTextFile(ByVal sFileName As String) As String
Dim Handle As Integer
' ensure that the file exists
If Len(Dir$(sFileName)) = 0 Then
Err.Raise 53 ' File not found
End If
' open in binary mode
Handle = FreeFile
Open sFileName$ For Binary As #Handle
' read the string and close the file
ReadTextFile = Space$(LOF(Handle))
Get #Handle, , ReadTextFile
Close #Handle
End Function
also a good tool to have is the Mitec Json Viewer. its free for personal use.
now add the 2 items below to the main form1. save the project to a folder.
place JOSON.txt in the same folder.
now run and click the button.
Code:
Private Sub Command1_Click()
Dim Result As String
Result = ReadTextFile(App.Path & "\JOSON.txt")
Dim p As Object
Set p = mdJson.JsonParseObject(Result)
If p Is Nothing Then
Exit Sub
End If
VSFActions.Rows = 0
Debug.Print JsonValue(p, "data/cf")
Debug.Print JsonValue(p, "data/denominazione")
Debug.Print JsonValue(p, "data/dettaglio/rea")
Debug.Print JsonValue(p, "data/gps/coordinates").Count
Debug.Print JsonValue(p, "data/gps/coordinates/0")
Debug.Print JsonValue(p, "data/gps/coordinates/1")
End Sub
Code:
Public Function ReadTextFile(ByVal sFileName As String) As String
Dim Handle As Integer
' ensure that the file exists
If Len(Dir$(sFileName)) = 0 Then
Err.Raise 53 ' File not found
End If
' open in binary mode
Handle = FreeFile
Open sFileName$ For Binary As #Handle
' read the string and close the file
ReadTextFile = Space$(LOF(Handle))
Get #Handle, , ReadTextFile
Close #Handle
End Function
also a good tool to have is the Mitec Json Viewer. its free for personal use.
Dim Json As New XiaoYaoJson2
Dim JsonStr As String
JsonStr = "{'Key1':'test1','abc':[""item1"",""item2"",""item3""]}"
Json.PutJsonStr JsonStr
Debug.Print Json.Item("Key1")
Debug.Print Json("key1")
Json("Key1") = "new Value1"
Json("Key2") = "new Value2"
Json("key2") = "new Value3"
Json.JsonObj.Key1 = "new Value4"
'obj.item can be operated directly if only the key name exists, and is case sensitive
Debug.Print Json.GetJsonObjectStrFormat
{
"Key1": "new Value4",
"abc": [
"item1",
"item2",
"item3"
],
"Key2": "new Value2",
"key2": "new Value3"
}
Dim p As Object, JsonStr As String
JsonStr = "{'abc':[""item1"",""item2"",""item3""] ,'KKK':333 ,'data':{'cf':'cf value','denominazione':'value2'} }"
Set p = JsonParseObject(JsonStr)
If p Is Nothing Then
Exit Sub
End If
Debug.Print JsonValue(p, "data/cf")
Debug.Print JsonValue(p, "data/denominazione")
the crusty old ms script control can be used as well
Code:
Private Sub Form_Load()
Dim jsonstr As String
jsonstr = "{'abc':[""item1"",""item2"",""item3""] ,'KKK':333 ,'data':{'cf':'cf value','denominazione':'value2'} }"
If Not LoadJson(jsonstr) Then Exit Sub
Debug.Print sc.Eval("json.data.cf")
Debug.Print sc.Eval("json.data.denominazione")
End Sub
Function LoadJson(ByVal JSON As String) As Boolean
On Error Resume Next
sc.Reset
JSON = "var None=''; var True=1; var False=0; var json = " & JSON
sc.AddCode JSON
LoadJson = (Err.Number = 0)
End Function
the crusty old ms script control can be used as well
Code:
Private Sub Form_Load()
Dim jsonstr As String
jsonstr = "{'abc':[""item1"",""item2"",""item3""] ,'KKK':333 ,'data':{'cf':'cf value','denominazione':'value2'} }"
If Not LoadJson(jsonstr) Then Exit Sub
Debug.Print sc.Eval("json.data.cf")
Debug.Print sc.Eval("json.data.denominazione")
End Sub
Function LoadJson(ByVal JSON As String) As Boolean
On Error Resume Next
sc.Reset
JSON = "var None=''; var True=1; var False=0; var json = " & JSON
sc.AddCode JSON
LoadJson = (Err.Number = 0)
End Function
Hi bro...
i have a difficult to parse this file!
not have the same structure of first file.
sorry me and tks for patience.
your data is not a single json blob. it is many different ones each on its own line.
Code:
{"type":"Feature","properties":{"hash":"f86c81a77c8ab0be","number":"144","street":"Via dell'Isola Farnese","unit":"","city":"ROMA","district":"ROMA","region":"LAZIO","postcode":"00123","id":"13800020324848"},"geometry":{"type":"Point","coordinates":[12.388608,42.018851]}}
{"type":"Feature","properties":{"hash":"d222b720a5d7e71a","number":"20","street":"Via delle Mimose","unit":"","city":"ROCCA PRIORA","district":"ROMA","region":"LAZIO","postcode":"00040","id":"13800020805729"},"geometry":{"type":"Point","coordinates":[12.745922,41.786285]}}
Its often handy to send these through js beautifier to see their structure easily...
https://beautifier.io/
{
"type": "Feature",
"properties": {
"hash": "0471ff336a327263",
"number": "23",
"street": "Via 4 Aprile",
"unit": "",
"city": "ARAGONA",
"district": "AGRIGENTO",
"region": "SICILIA",
"postcode": "92021",
"id": "13800023883257"
},
"geometry": {
"type": "Point",
"coordinates": [13.616626, 37.405944]
}
}
You have to parse each element individually.
Code:
Private Sub Form_Load()
Dim jsonFile As String, line() As String, i As Long, errs As Long
sc.UseSafeSubset = True
sc.Language = "JScript"
jsonFile = ReadFile(app.path & "\test_json.txt")
line = Split(jsonFile, vbCrLf)
For i = 0 To UBound(line)
If Len(line(i)) > 0 Then
If Not LoadJson(line(i)) Then
Debug.Print "Error on element: " & i & " Error Line:" & sc.Error.line & ": " & sc.Error.Description
errs = errs + 1
Else
Debug.Print i & ") " & sc.Eval("json.properties.city")
End If
End If
Next
Debug.Print "Errors: " & errs
End Sub
Function LoadJson(ByVal JSON As String) As Boolean
On Error Resume Next
sc.Reset
JSON = "var None=''; var True=1; var False=0; var json = " & JSON
sc.AddCode JSON
LoadJson = (Err.Number = 0)
End Function
Function ReadFile(filename)
Dim f, temp
f = FreeFile
temp = ""
Open filename For Binary As #f ' Open file.(can be text or image)
temp = Input(FileLen(filename), #f) ' Get entire Files data
Close #f
ReadFile = temp
End Function
your data is not a single json blob. it is many different ones each on its own line.
Code:
{"type":"Feature","properties":{"hash":"f86c81a77c8ab0be","number":"144","street":"Via dell'Isola Farnese","unit":"","city":"ROMA","district":"ROMA","region":"LAZIO","postcode":"00123","id":"13800020324848"},"geometry":{"type":"Point","coordinates":[12.388608,42.018851]}}
{"type":"Feature","properties":{"hash":"d222b720a5d7e71a","number":"20","street":"Via delle Mimose","unit":"","city":"ROCCA PRIORA","district":"ROMA","region":"LAZIO","postcode":"00040","id":"13800020805729"},"geometry":{"type":"Point","coordinates":[12.745922,41.786285]}}
Its often handy to send these through js beautifier to see their structure easily...
https://beautifier.io/
{
"type": "Feature",
"properties": {
"hash": "0471ff336a327263",
"number": "23",
"street": "Via 4 Aprile",
"unit": "",
"city": "ARAGONA",
"district": "AGRIGENTO",
"region": "SICILIA",
"postcode": "92021",
"id": "13800023883257"
},
"geometry": {
"type": "Point",
"coordinates": [13.616626, 37.405944]
}
}
You have to parse each element individually.
Code:
Private Sub Form_Load()
Dim jsonFile As String, line() As String, i As Long, errs As Long
sc.UseSafeSubset = True
sc.Language = "JScript"
jsonFile = ReadFile(app.path & "\test_json.txt")
line = Split(jsonFile, vbCrLf)
For i = 0 To UBound(line)
If Len(line(i)) > 0 Then
If Not LoadJson(line(i)) Then
Debug.Print "Error on element: " & i & " Error Line:" & sc.Error.line & ": " & sc.Error.Description
errs = errs + 1
Else
Debug.Print i & ") " & sc.Eval("json.properties.city")
End If
End If
Next
Debug.Print "Errors: " & errs
End Sub
Function LoadJson(ByVal JSON As String) As Boolean
On Error Resume Next
sc.Reset
JSON = "var None=''; var True=1; var False=0; var json = " & JSON
sc.AddCode JSON
LoadJson = (Err.Number = 0)
End Function
Function ReadFile(filename)
Dim f, temp
f = FreeFile
temp = ""
Open filename For Binary As #f ' Open file.(can be text or image)
temp = Input(FileLen(filename), #f) ' Get entire Files data
Close #f
ReadFile = temp
End Function
the sc object was an instance of the Microsoft Script Control.
You can either Add Component MSScriptControl then put an instance on your form named sc
or the following will work too
Code:
Dim sc As Object
Private Sub Form_Load()
Dim jsonFile As String, line() As String, i As Long, errs As Long
Set sc = CreateObject("MSScriptControl.ScriptControl")
the sc object was an instance of the Microsoft Script Control.
You can either Add Component MSScriptControl then put an instance on your form named sc
or the following will work too
Code:
Dim sc As Object
Private Sub Form_Load()
Dim jsonFile As String, line() As String, i As Long, errs As Long
Set sc = CreateObject("MSScriptControl.ScriptControl")
the sc object was an instance of the Microsoft Script Control.
You can either Add Component MSScriptControl then put an instance on your form named sc
or the following will work too
Code:
Dim sc As Object
Private Sub Form_Load()
Dim jsonFile As String, line() As String, i As Long, errs As Long
Set sc = CreateObject("MSScriptControl.ScriptControl")
wow!!!!
Work, perferct.
but i have a null value in the last node:
Debug.Print i & ") " & UCase(SC.Eval("json.properties.coordinates"))
sorry, but i cannot set the last modify of code, based coordinates.
can you post the correct code?
tks.
my last code:
Code:
Private Sub Form_Load()
Dim jsonFile As String, line() As String, i As Long, errs As Long
Set SC = CreateObject("MSScriptControl.ScriptControl")
SC.UseSafeSubset = True
SC.Language = "JScript"
jsonFile = ReadFile("C:\TABULATI\test_json.txt")
line = Split(jsonFile, vbCrLf)
For i = 0 To UBound(line)
If Len(line(i)) > 0 Then
If Not LoadJson(line(i)) Then
Debug.Print "Error on element: " & i & " Error Line:" & SC.Error.line & ": " & SC.Error.Description
errs = errs + 1
Else
Debug.Print i & ") " & SC.Eval("json.properties.city")
Debug.Print i & ") " & SC.Eval("json.properties.number")
Debug.Print i & ") " & UCase(SC.Eval("json.properties.street"))
Debug.Print i & ") " & UCase(SC.Eval("json.properties.city"))
Debug.Print i & ") " & UCase(SC.Eval("json.properties.district"))
Debug.Print i & ") " & UCase(SC.Eval("json.properties.region"))
Debug.Print i & ") " & UCase(SC.Eval("json.properties.postcode"))
Debug.Print i & ") " & UCase(SC.Eval("json.properties.id"))
JSON.geometry.coordinates
Debug.Print i & ") " & JSON.geometry.coordinates; [0]
Debug.Print i & ") " & JSON.geometry.coordinates; [1]
Debug.Print i & ") " & json.geometry.coordinates.join("\t')
'Debug.Print i & ") " & UCase(SC.Eval("json.properties.coordinates"))
End If
End If
Next
Debug.Print "Errors: " & errs
End Sub
Last edited by luca90; May 29th, 2023 at 11:44 AM.