An attempt to read json into table.
This one is a work in progress, tested and worked, but may not before modifying to match the new needs.
Function JSON_To_Table(JsonContent)
'
'
UISetup
Frm7.Reset
ThisCompany = shJ.Range("C2").Value
URL_JSon = shJ.Range("C3").Value
ThisCIK = shJ.Range("D2").Value
ThisDate = shJ.Range("E2").Value
shJ.Range("A1", "BBA1").EntireColumn.ClearContents
shJ.Range("C2").Value = ThisCompany
shJ.Range("C3").Value = URL_JSon
shJ.Range("D2").Value = "'" & ThisCIK
shJ.Range("E2").Value = ThisDate
shJ.Range("A5").Offset(, 1).Value = "ID"
shJ.Range("A5").Offset(, 2).Value = "FieldID"
shJ.Range("A5").Offset(, 3).Value = "Label"
shJ.Range("A5").Offset(, 4).Value = "Description"
shJ.Range("A5").Offset(, 5).Value = "Unit"
shJ.Range("A5").Offset(, 6).Value = "Start" ' smallest part
shJ.Range("A5").Offset(, 7).Value = "End"
shJ.Range("A5").Offset(, 8).Value = "Val" ' smallest part
shJ.Range("A5").Offset(, 9).Value = "accn"
shJ.Range("A5").Offset(, 10).Value = "fy" ' smallest part
shJ.Range("A5").Offset(, 11).Value = "fp"
shJ.Range("A5").Offset(, 12).Value = "form" ' smallest part
shJ.Range("A5").Offset(, 13).Value = "Filled" ' smallest part
shJ.Range("A5").Offset(, 14).Value = "Frame" ' smallest part
shJ.Range("AA4").Offset(, 0).Value = "Unique list of fields"
shJ.Range("AA5").Offset(, 0).Value = "FieldID"
X1 = VBInstr("facts", JsonContent)
X2 = VBInstr("us-gaap", JsonContent, X1)
MaxJS = Len(JsonContent)
If X1 = 0 Or X2 = 0 Then GoTo ByeBye
RowID1 = 0
FieldID2 = strUnQuote(CutString(JsonContent, "{", ":", X2))
ReadNextField:
J2 = SettingRead_JSon_Block(FieldID2, JsonContent)
Label3 = CutString(J2, "label"":""", """")
Descrp4 = CutString(J2, "description"":""", """")
Unit5Block = SettingRead_JSon_Block("units"":", J2)
Unit5 = strUnQuote(CutString(Unit5Block, , ":"))
SmallX1 = 1
Smallest = CutString3(Unit5Block, SmallX1, "}")
NextQuarter:
Start6 = SettingRead_JSON("start"":""", Smallest)
End7 = SettingRead_JSON("end"":""", Smallest)
Val8 = SettingRead_JSON("val"":", Smallest)
Accn9 = SettingRead_JSON("accn"":""", Smallest)
FY10 = SettingRead_JSON("fy"":""", Smallest)
FP11 = SettingRead_JSON("fp"":", Smallest)
Form12 = SettingRead_JSON("form"":""", Smallest)
Filed13 = SettingRead_JSON("filed"":""", Smallest)
Frame14 = SettingRead_JSON("frame"":", Smallest)
' Do we all values???
If Start6 = "" And End7 = "" And Val8 = "" And Accn9 = "" And FY10 = "" And FP11 = "" And Form12 = "" And Filed13 = "" And Frame14 = "" Then GoTo DontAddRow
' Adding row and fill in values from json
RowID1 = RowID1 + 1
shJ.Range("A5").Offset(RowID1, 1).Value = RowID1
shJ.Range("A5").Offset(RowID1, 2).Value = strUnQuote(FieldID2)
shJ.Range("A5").Offset(RowID1, 3).Value = Label3
shJ.Range("A5").Offset(RowID1, 4).Value = Descrp4
shJ.Range("A5").Offset(RowID1, 5).Value = Unit5
shJ.Range("A5").Offset(RowID1, 6).Value = Start6
shJ.Range("A5").Offset(RowID1, 7).Value = End7
shJ.Range("A5").Offset(RowID1, 8).Value = Val8
shJ.Range("A5").Offset(RowID1, 9).Value = Accn9
shJ.Range("A5").Offset(RowID1, 10).Value = FY10
shJ.Range("A5").Offset(RowID1, 11).Value = FP11
shJ.Range("A5").Offset(RowID1, 12).Value = Form12
shJ.Range("A5").Offset(RowID1, 13).Value = Filed13
shJ.Range("A5").Offset(RowID1, 14).Value = Frame14
DontAddRow:
SmallX1 = SmallX1 + 1
Smallest = CutString3(Unit5Block, SmallX1, "}")
If Smallest < > Unit5Block Then GoTo NextQuarter
X3 = VBInstr(J2, JsonContent) + Len(J2)
If X3 < X2 Then
msgbox "Found an instance that we already got. Wrong scenario we need to fix...", vbcritical
Stop
End If
X2 = X3
FieldID2 = CutString(JsonContent, ",", ":", X2)
If Len(FieldID2) < 4 Then
If FieldID2 < > "}}}" Then
MsgBox "Possible infinite loop!", vbCritical
Stop
Else
GoTo ByeBye
End If
End If
Frm7.Update X2, MaxJS
If X2 < MaxJS Then GoTo ReadNextField
ByeBye:
UISetup
Frm7.Endd
End Function
'
'
UISetup
Frm7.Reset
ThisCompany = shJ.Range("C2").Value
URL_JSon = shJ.Range("C3").Value
ThisCIK = shJ.Range("D2").Value
ThisDate = shJ.Range("E2").Value
shJ.Range("A1", "BBA1").EntireColumn.ClearContents
shJ.Range("C2").Value = ThisCompany
shJ.Range("C3").Value = URL_JSon
shJ.Range("D2").Value = "'" & ThisCIK
shJ.Range("E2").Value = ThisDate
shJ.Range("A5").Offset(, 1).Value = "ID"
shJ.Range("A5").Offset(, 2).Value = "FieldID"
shJ.Range("A5").Offset(, 3).Value = "Label"
shJ.Range("A5").Offset(, 4).Value = "Description"
shJ.Range("A5").Offset(, 5).Value = "Unit"
shJ.Range("A5").Offset(, 6).Value = "Start" ' smallest part
shJ.Range("A5").Offset(, 7).Value = "End"
shJ.Range("A5").Offset(, 8).Value = "Val" ' smallest part
shJ.Range("A5").Offset(, 9).Value = "accn"
shJ.Range("A5").Offset(, 10).Value = "fy" ' smallest part
shJ.Range("A5").Offset(, 11).Value = "fp"
shJ.Range("A5").Offset(, 12).Value = "form" ' smallest part
shJ.Range("A5").Offset(, 13).Value = "Filled" ' smallest part
shJ.Range("A5").Offset(, 14).Value = "Frame" ' smallest part
shJ.Range("AA4").Offset(, 0).Value = "Unique list of fields"
shJ.Range("AA5").Offset(, 0).Value = "FieldID"
X1 = VBInstr("facts", JsonContent)
X2 = VBInstr("us-gaap", JsonContent, X1)
MaxJS = Len(JsonContent)
If X1 = 0 Or X2 = 0 Then GoTo ByeBye
RowID1 = 0
FieldID2 = strUnQuote(CutString(JsonContent, "{", ":", X2))
ReadNextField:
J2 = SettingRead_JSon_Block(FieldID2, JsonContent)
Label3 = CutString(J2, "label"":""", """")
Descrp4 = CutString(J2, "description"":""", """")
Unit5Block = SettingRead_JSon_Block("units"":", J2)
Unit5 = strUnQuote(CutString(Unit5Block, , ":"))
SmallX1 = 1
Smallest = CutString3(Unit5Block, SmallX1, "}")
NextQuarter:
Start6 = SettingRead_JSON("start"":""", Smallest)
End7 = SettingRead_JSON("end"":""", Smallest)
Val8 = SettingRead_JSON("val"":", Smallest)
Accn9 = SettingRead_JSON("accn"":""", Smallest)
FY10 = SettingRead_JSON("fy"":""", Smallest)
FP11 = SettingRead_JSON("fp"":", Smallest)
Form12 = SettingRead_JSON("form"":""", Smallest)
Filed13 = SettingRead_JSON("filed"":""", Smallest)
Frame14 = SettingRead_JSON("frame"":", Smallest)
' Do we all values???
If Start6 = "" And End7 = "" And Val8 = "" And Accn9 = "" And FY10 = "" And FP11 = "" And Form12 = "" And Filed13 = "" And Frame14 = "" Then GoTo DontAddRow
' Adding row and fill in values from json
RowID1 = RowID1 + 1
shJ.Range("A5").Offset(RowID1, 1).Value = RowID1
shJ.Range("A5").Offset(RowID1, 2).Value = strUnQuote(FieldID2)
shJ.Range("A5").Offset(RowID1, 3).Value = Label3
shJ.Range("A5").Offset(RowID1, 4).Value = Descrp4
shJ.Range("A5").Offset(RowID1, 5).Value = Unit5
shJ.Range("A5").Offset(RowID1, 6).Value = Start6
shJ.Range("A5").Offset(RowID1, 7).Value = End7
shJ.Range("A5").Offset(RowID1, 8).Value = Val8
shJ.Range("A5").Offset(RowID1, 9).Value = Accn9
shJ.Range("A5").Offset(RowID1, 10).Value = FY10
shJ.Range("A5").Offset(RowID1, 11).Value = FP11
shJ.Range("A5").Offset(RowID1, 12).Value = Form12
shJ.Range("A5").Offset(RowID1, 13).Value = Filed13
shJ.Range("A5").Offset(RowID1, 14).Value = Frame14
DontAddRow:
SmallX1 = SmallX1 + 1
Smallest = CutString3(Unit5Block, SmallX1, "}")
If Smallest < > Unit5Block Then GoTo NextQuarter
X3 = VBInstr(J2, JsonContent) + Len(J2)
If X3 < X2 Then
msgbox "Found an instance that we already got. Wrong scenario we need to fix...", vbcritical
Stop
End If
X2 = X3
FieldID2 = CutString(JsonContent, ",", ":", X2)
If Len(FieldID2) < 4 Then
If FieldID2 < > "}}}" Then
MsgBox "Possible infinite loop!", vbCritical
Stop
Else
GoTo ByeBye
End If
End If
Frm7.Update X2, MaxJS
If X2 < MaxJS Then GoTo ReadNextField
ByeBye:
UISetup
Frm7.Endd
End Function
JsonContent
Views 100
Downloads 29
CodeID
DB ID
ANmarAmdeen
626
Revisions
v1.0
Thursday
June
6
2024