JSON_To_Table

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.

CodeFunctionName
What is this?

Public

Tested

Original Work
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

JsonContent

Views 76

Downloads 27

CodeID
DB ID