JSON into excel from vb string

[andyt2005]

Good morning all,

Im in a real pickle and in need of some help from some experts out there, Im trying to get a web API through vb(done) then get the data from it into cells.
The data is returned in JSON, which is where im stuck.
Its basically a Q&A database, each question has a ref no assigned to it however im having issues getting what i need.
Heres a sample of the JSON:

{"meta":{"offset":0,"limit":50,"total":22},"data":[{"key":12094,"name":"How are you feeling?","locale":"en-US"},{"key":4214,"name":"How are you feeling about life?","locale":"en-US"},{"key":738,"name":"How clean was your house today?","locale":"en-US"},{"key":10224,"name":"How clean was your car?","locale":"en-US"},

So all i need is the "key" and the actual question. the VB store this JSON as a string once it has returned it. Its the storting the good from the bad i need help with. Note: Questions returned will and do change so counting lengh is no good for this.

Any ideas/help would be amazing!

Thanks

 

[pgc01]

Hi

For the string you posted what is the result you expect (values and layout)?

 

[andyt2005]

Hi, The output id expect is 2 Cols, one displaying the "key" value and one showing the question value. Rows would depend on the amount of questions being asked at the time.

So for first part id expect to see,

12094 How are you feeling?
4214 How are you feeling about life?

And so on

 

[Peter_SSs]

One sample isn't a lot to go on but give this a try in a copy of your workbook.

Sub GetQns()
  Dim data, results, bits
  Dim i As Long, j As Long, k As Long
  
  data = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim results(1 To 2, 0 To 0)
  For i = 1 To UBound(data)
    bits = Split(data(i, 1), """key"":")
    ReDim Preserve results(1 To 2, 1 To UBound(results, 2) + UBound(bits))
    For j = 1 To UBound(bits)
      k = k + 1
      results(1, k) = Split(bits(j), ",")(0)
      results(2, k) = Split(bits(j), """")(3)
    Next j
  Next i
  Range("B2:C2").Resize(k).Value = Application.Transpose(results)
End Sub

With sample data in column A, the code produced columns B:C

Excel Workbook
	A	B	C
1
2	{"meta":{"offset":0,"limit":50,"total":22},"data":[{"key":12094,"name":"How are you feeling?","locale":"en-US"},{"key":4214,"name":"How are you feeling about life?","locale":"en-US"},{"key":738,"name":"How clean was your house today?","locale":"en-US"},{"key":10224,"name":"How clean was your car?","locale":"en-US"},	12094	How are you feeling?
3	{"meta":{"offset":0,"limit":50,"total":22},"data":[{"key":864,"name":"What music do you like?","locale":"en-US"},{"key":4444,"name":"How old are you?","locale":"en-US"},{"key":2,"name":"What day is it?","locale":"en-US"},	4214	How are you feeling about life?
4		738	How clean was your house today?
5		10224	How clean was your car?
6		864	What music do you like?
7		4444	How old are you?
8		2	What day is it?
9
Extract Text

 

[andyt2005]

Looks perfect, i shall give it a go and let you know how i get on.
Thanks

 

[andyt2005]

Im getting a type mismatch on For i = 1 To UBound(data).

i was hoping to do it all in VB with no helper col, ideally doing a loop for each result. Im completely lost when it comes to this.

One sample isn't a lot to go on but give this a try in a copy of your workbook.

Sub GetQns()
  Dim data, results, bits
  Dim i As Long, j As Long, k As Long
  
  data = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim results(1 To 2, 0 To 0)
  For i = 1 To UBound(data)
    bits = Split(data(i, 1), """key"":")
    ReDim Preserve results(1 To 2, 1 To UBound(results, 2) + UBound(bits))
    For j = 1 To UBound(bits)
      k = k + 1
      results(1, k) = Split(bits(j), ",")(0)
      results(2, k) = Split(bits(j), """")(3)
    Next j
  Next i
  Range("B2:C2").Resize(k).Value = Application.Transpose(results)
End Sub

With sample data in column A, the code produced columns B:C

Extract Text

*	A	B	C
1	*	*	*
2	{"meta":{"offset":0,"limit":50,"total":22},"data":[{"key":12094,"name":"How are you feeling?","locale":"en-US"},{"key":4214,"name":"How are you feeling about life?","locale":"en-US"},{"key":738,"name":"How clean was your house today?","locale":"en-US"},{"key":10224,"name":"How clean was your car?","locale":"en-US"},	12094	How are you feeling?
3	{"meta":{"offset":0,"limit":50,"total":22},"data":[{"key":864,"name":"What music do you like?","locale":"en-US"},{"key":4444,"name":"How old are you?","locale":"en-US"},{"key":2,"name":"What day is it?","locale":"en-US"},	4214	How are you feeling about life?
4	*	738	How clean was your house today?
5	*	10224	How clean was your car?
6	*	864	What music do you like?
7	*	4444	How old are you?
8	*	2	What day is it?
9	*	*	*

<COLGROUP><COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 721px"><COL style="WIDTH: 72px"><COL style="WIDTH: 370px"></COLGROUP><TBODY>
</TBODY>

Excel tables to the web >> Excel Jeanie HTML 4

 

[Peter_SSs]

Im getting a type mismatch on For i = 1 To UBound(data).

Do you only have one cell with data?
If so, is that your real situation?

If not, try it with at least 2 cells like my sample.

i was hoping to do it all in VB with no helper col,...

Not quite sure what you mean? Please clarify.

I didn't use a helper column - data in one column - results in the other two columns. Where is your string if it isn't in a cell?

 

[andyt2005]

Ok, think iv explained myself wrong, Sorry. The JSON string is returned from the WEB API and stored in a VB Variable, Called ReturnedString. So the "end" user doesnt see the string. id like it to loop through the string and say " o heres a key, lets pull this and then pull the question with it" and then dump those two findings into cells, like we have done. So the actual JSON string will always start as a variable and ideally stay in vb either updating the variable or writing it to another. My long term goal is to transfer this to access so would like everything to stay in VB and just add new entries into a database. but thats for another day.

 

[Comfy]

Have a look at this post Parsing JSON in Excel VBA - Stack Overflow

It will return your JSon as an array:

Option Explicit

Private ScriptEngine As Object

Public Sub InitScriptEngine()
    Set ScriptEngine = CreateObject("ScriptControl")
    ScriptEngine.Language = "JScript"
    ScriptEngine.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "
    ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "
End Sub

Public Function DecodeJsonString(ByVal JsonString As String)
    Set DecodeJsonString = ScriptEngine.Eval("(" + JsonString + ")")
End Function

Public Function GetProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Variant
    GetProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)
End Function

Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Object
    Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)
End Function

Public Function GetKeys(ByVal JsonObject As Object) As String()
    Dim Length As Integer
    Dim KeysArray() As String
    Dim KeysObject As Object
    Dim Index As Integer
    Dim Key As Variant

    Set KeysObject = ScriptEngine.Run("getKeys", JsonObject)
    Length = GetProperty(KeysObject, "length")
    ReDim KeysArray(Length - 1)
    Index = 0
    For Each Key In KeysObject
        KeysArray(Index) = Key
        Index = Index + 1
    Next
    GetKeys = KeysArray
End Function


Public Sub TestJsonAccess()
    Dim JsonString As String
    Dim JsonObject As Object
    Dim Keys() As String
    Dim Value As Variant
    Dim j As Variant

    InitScriptEngine

    JsonString = "{""meta"":{""offset"":0,""limit"":50,""total"":22},""data"":[{""key"":12094,""name"":""How are you feeling?"",""locale"":""en-US""},{""key"":4214,""name"":""How are you feeling about life? "",""locale"":""en-US""}]}"
    Set JsonObject = DecodeJsonString(CStr(JsonString))
    Keys = GetKeys(JsonObject)

    Value = GetProperty(JsonObject, "meta")
    Set Value = GetObjectProperty(JsonObject, "data")
End Sub

 

[Comfy]

I've updated the 'TestJsonAccess' so show how to retrieve the data from each record.

Public Sub TestJsonAccess()
    Dim JsonString As String
    Dim JsonObject As Object
    Dim Keys() As String
    Dim Value As Variant
    Dim Val1 As Variant
    Dim j As Long

    InitScriptEngine

    JsonString = "{""meta"":{""offset"":0,""limit"":50,""total"":22},""data"":[{""key"":12094,""name"":""How are you feeling?"",""locale"":""en-US""},{""key"":4214,""name"":""How are you feeling about life? "",""locale"":""en-US""}]}"
    Set JsonObject = DecodeJsonString(CStr(JsonString))

    Set Value = GetObjectProperty(JsonObject, "data")
    Keys = GetKeys(Value)
    For j = LBound(Keys) To UBound(Keys)
        Set Val1 = GetObjectProperty(Value, Keys(j))
        Debug.Print GetProperty(Val1, "key")
        Debug.Print GetProperty(Val1, "name")
        Debug.Print GetProperty(Val1, "locale")
    Next j


End Sub