I have this json array and the data I need is in the array that starts data_id which I cannot extract. I am able to extract keys,value before the array but not in the array. I believe I need to request data in a specific way with a number in () after the fieldname nest but I cannot find a beginners explanation to see what number goes in the brackets and why you chose that number.
{"api":{"results":37,"data":[{"data_id":643951,"location_id":3005,"person":{"name":"Bob","country":"Turkey",
Any tips appreciated here is some code
'Print a few object variables before parse
Dim WrkSht As Worksheet
Set WrkSht = ThisWorkbook.Worksheets("jsonoutput")
WrkSht.Cells(1, 1).Value = xml_obj.responseText
' Displays data fine in one string as shown above
'Parse the response
Set jp = JsonConverter.ParseJson(xml_obj.responseText)
For Each dict In jp
Debug.Print dict
If Not IsObject(jp(dict)) Then
Debug.Print jp(dict)
Else
For Each subDict In jp(dict)
Debug.Print subDict
'Debug.Print jp(dict)(subDict)
Next subDict
End If
Next dict
' I need to drill down into further levels but ?
End Sub
Here's a simple example
JSON used:
{"api":{"results":37,
"data":[{"data_id":643951,
"location_id":3005,
"person":{"name":"Bob","country":"Turkey"}
} ]
}}
Code:
Sub Test36()
Dim jso As Object, arr, data, obj
'loading from a cell for testing...
Set jso = JsonConverter.ParseJson(Sheet2.Range("A17").Value)
'jso is a Dictionary
Debug.Print jso("api")("results") '>> 37
Set data = jso("api")("data") 'data is a Collection
Debug.Print data.Count ' >> 1
For Each obj In data
Debug.Print obj("data_id") '>> 643951
Debug.Print obj("person")("country") '>> Turkey
Next obj
End Sub
I thought I would just share the code I ended up with. It can be improved on and some is over coded simply to make it easier to see where amendments can be made. Currently this will:
Access an API - just put as many header lines in as you need
Collect the JSON data and flatten it to one level - this code will only work with Json where
blank values are recorded as "null" rather than just "". You may
have to manually correct the columns (or update the code) for
blank values
Ask you which key you want to start with - it will
then mark that keys values to start a new row each time it comes
across this
Make replacements in the data to create delimiters
to mark which data is keys and which is values
Pastes your keys
in row 1 that have values - dictionary keys are ignored but
you can change that if needed
Remove all keys from the string to
just leave values and paste those in the rows below.
You need to have the RunScriptime XMl HTTP 6.0 and Object library ticked in Tools reference in VBA as well
Sub FlattenJsonGetDataFromKeysWithValues()
ActiveWorkbook.Worksheets("yourworksheet").Range("a1:ZZ10000").ClearContents
Dim i As Long
'Declare variables
Dim xml_obj As MSXML2.XMLHTTP60
Dim base_url As String
Dim Json1 As String, Json2, Json3, Json4, Json5, Json6, json7, Json8, Json9, Json10, Json11, Json12, Json13, Json14, Json15, Json16, Json17, Json18
Dim Json0 As String
Dim keys As String, keys2
'Create a new Request Object make sure in Tools-> reference the xml6.0, scripting runtime and object library are ticked
Set xml_obj = New MSXML2.XMLHTTP60
'Define URL Components two headers are shown but you cana dd as many as required
base_url = "https://yoururl.com"
xml_obj.Open "GET", base_url
xml_obj.SetRequestHeader "key", "55555"
xml_obj.SetRequestHeader "host", "valuefor2ndheaderkeyifneeded"
xml_obj.Send
'Print the status code in case something went wrong
MsgBox("The Request was " + CStr(xml_obj.Status))
strJson0 = xml_obj.responseText
MsgBox (Len(strJson0)) ' tells how long string is
'Look for Json current delimiters and change all to a comma
Json1 = strJson0
Const SpecialCharacters As String = "!,#,#,$,%,^,&,*,(,),{,[,],},?,:"
Dim char As Variant
For Each char In Split(SpecialCharacters, ",")
Json1 = Replace(Json1, char, " ")
Next
' Place # before all field names, I have shown in this way so if needed you can vary to suit your needs
Json2 = Replace(Json1, "," & Chr(34), "#") ' Replaces ," - Chr(34) is a "
Json3 = Replace(Json2, ", " & Chr(34), "#") ' replaces , "
Json4 = Replace(Json3, Chr(34) & " " & Chr(34), Chr(34) & "#") ' Replaces " "
Json5 = Replace(Json4, Chr(34) & " " & Chr(34), Chr(34) & "#") ' Replaces " "
'Place : after fieldname and before value
Json6 = Replace(Json5, Chr(34) & " " & Chr(34), ":") 'Replaces " "
json7 = Replace(Json6, Chr(34) & " ", ":") 'Replaces "(blankspace)
Json8 = Replace(json7, Chr(34), ":") 'Replaces "
Json9 = Replace(Json8, ":#", "#") 'Replaces :# with #
Json10 = Replace(Json9, "/", "") 'Removes /
Json11 = Replace(Json10, " ", "") 'Removes blankspace
If Left(Json11, 1) = ":" Then Json11 = "#" & Right(Json11, (Len(Json11) - 1)) ' Replace : with # if first character
' Now you just have field names (keys) marked by # and values marked by :
' Find Field Names - which field should we start with? How many times is that key in the data
Dim firstkey As String
MsgBox (Json11) 'View this to see your key/header row options
firstkey = InputBox("Enter First Field/Key to locate") 'This will mark where all new rows start
keys = Json11
' Now take text between #*# as dictionary keys and ignore and text between #*: as headers for field names until repeat text is found in string by finding the firstkey you input above and putting a # marker in all heading that = firstkey
Dim openPos As Long
Dim closePos As Long
Dim k As Integer
Dim jsonFields As Collection
Set jsonFields = New Collection
Dim jsonValues As Collection
Set jsonValues = New Collection
' Find wanted starting key, skip over keys without value
k = 1
openPos = InStr(keys, firstkey)
closePos = InStr(openPos, keys, ":")
If InStr(1, Mid(keys, openPos, closePos - openPos), "#") > 0 Then openPos = openPos + InStr(1, Mid(keys, openPos, closePos - openPos), "#")
jsonFields.Add Mid(keys, openPos, closePos - openPos)
keys = Replace(keys, firstkey & ":", ":#")
k = k + 1
' Find other keys with values, find dict keys
Do Until Mid(keys, openPos, closePos - openPos) = ""
openPos = InStr(closePos, keys, "#") + 1
If k = 2 Then openPos = InStr(1, keys, "#")
closePos = InStr(openPos, keys, ":")
If InStr(1, Mid(keys, openPos, closePos - openPos), "#") > 0 Then openPos = openPos + InStr(1, Mid(keys, openPos, closePos - openPos), "#")
jsonFields.Add Mid(keys, openPos, closePos - openPos)
k = k + 1
Loop
' Find values and remove delimiters, keys and replace : in https values that are removed with other delimiters
y = 2 ' use to start populate rows
currentcolumn = 1
Dim r&
p = Split(keys, "#")
For r = 0 To UBound(p)
If InStr(1, p(r), ":") Then p(r) = Right(p(r), Len(p(r)) - InStr(1, p(r), ":") + 1) ' remove keys
If InStr(1, p(r), ":") = 0 Then p(r) = "" ' remove :
If InStr(1, p(r), ":") Then p(r) = Right(p(r), Len(p(r)) - InStr(1, p(r), ":")) ' set value for collection to print later
If InStr(1, p(r), "https") Then p(r) = Replace(p(r), "https", "https:") ' fix https value by readding :
jsonValues.Add p(r) ' add to collection
Next r
' Print Values to worksheet
currentcolumn = 1
'Now Output your parsed key data, turn screen updating off
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Item In jsonFields
ActiveWorkbook.Worksheets("yourworksheet").Cells(1, currentcolumn).Value = Item
currentcolumn = currentcolumn + 1
Next Item
y = 2
currentcolumn = 1
Dim ws As Worksheet
Set ws = Worksheets("yourworksheet")
For Each Item In jsonValues
If Len(Item) > 0 Then
If InStr(1, Item, "#") = 1 Then
y = y + 1
currentcolumn = 1
End If
ws.Cells(y, currentcolumn).Value = Item
currentcolumn = currentcolumn + 1
End If
Next Item
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
I desperately tried to separate a specific part of a string with an Expression (Mid/InStr).
String: Transfered from 'Doe, John' to '', Transfered from Group 'Customer' to 'Service'
I need the group value: Service
Can anyone help? Is it possible?
I was able to do it with a function.
Example:
Textbox Expression:
=Code.GetTransferedGroup(Fields!YourColumnNameHere.Value)
Code:
Public Function GetTransferedGroup(columnValue As String) As String
'--------------------------------------------------------------------------------------------------------------------
' Purpose: Seperate part of a string
' Example: =Code.GetTransferedGroup("Transfered from 'Doe, John' to '', Transfered from Group 'Customer' to 'Service'")
' Reference: https://stackoverflow.com/questions/52658830/ssrs-seperate-part-of-a-string-and-return
'--------------------------------------------------------------------------------------------------------------------
Const transferedHeader As String = "Transfered from Group"
Const transferedTerm As String = " to "
Dim transferedPart As Integer
Dim transferedValues As String
Try
transferedPart = InStr(1, columnValue, transferedHeader, vbBinaryCompare)
transferedValues = Mid(columnValue, transferedPart + Len(transferedHeader) + 1, Len(columnValue) - (transferedPart + Len(transferedHeader)))
return Replace(Mid(transferedValues, InStr(1, transferedValues, transferedTerm) + Len(transferedTerm), Len(transferedValues) - InStr(1, transferedValues, transferedTerm)), "'", "")
Catch
return "Error"
End Try
End Function
Report Properties Code:
I want to add hyphenation to the column headers of a tablix
Consider the column value "waterbodiesinhereforme"
Currently SSRS is hyphenating based on the size it can fit inside the tablix column header. Like below .
waterbodiesinhereforme
But my requirement is
waterbodiesin-
hereforme
So far I have tried the soft hyphen character , which did not work in the ssrs even though html rendering was set to true. Even the Unicode "00AD" did not work.
When I tried with the ZeroWidthCharacter it worked correctly, but I do not know how to introduce a hyphen when there is a new line.
Zero Width Character Example
="water" + ChrW(&h200B) + "bodies" + ChrW(&h200B) + "in" + ChrW(&h200B) + "here" + ChrW(&h200B) + "for" + ChrW(&h200B) + "me"
Things I cannot do
- Hardcode the hyphen (not acceptable because this value is dynamic)
I've written this in Excel VBA, but this can be easily transferred to SSRS.
This splits the input string into parcels of 10 characters separated by carriage returns. You can change the string length by changing the initial value of IntSplit. You could add your zerowidthcharacter if you wanted. The Function code would need to be added to the "Report Properties>Code" section of the SSRS, with the string requiring the split being placed in the Expression for the field:
=code.SplitString(Fields!YourFieldName.value)
Here's the code ...
Private Sub do_it()
Dim strString As String
Dim StrNewString As String
strString = "This is a very long sentence that needs to be chunked up"
strString = SplitString(strString)
Debug.Print strString
End Sub
Private Function SplitString(ByVal strInput As String) As String
Dim StrOut As String
Dim IntSplit As Integer
Dim Intstart As Integer
Dim j As Integer
IntSplit = 10
Intstart = 1
StrOut = ""
For j = 1 To Len(strInput)
If Int(j / IntSplit) = j / IntSplit Then
StrOut = StrOut + Mid(strInput, Intstart, IntSplit) + vbCrLf
Intstart = j + 1
End If
Next
StrOut = StrOut + Mid(strInput, Intstart, Len(strInput) - (Intstart - 1))
SplitString = StrOut
'Return SplitString ' A Return statement is required in SSRS
End Function
Output
This is a
very long
sentence t
hat needs
to be chun
ked up
I'm trying to set up a code in MS Access that increments the last four positions of a text field. The numbers in the text field have seven digits. For example:
0010012
0010013
First three digits represent the manuacturer and the last four the product. These are the ones I want to increment. I am using the code below, which I found online, and it is supposed to be working but I keep getting the error: "Run-time error '13': Type mismatch"
Dim varSifra As Variant
varSifra = DMax("[Sifra]", "tblProducts", "[Manufacturer] = " & Forms!frmProduct!Manufacturer)
Me.[Sifra] = Left(varSifra, 3) & Format(Val(Right(varSifra, 4)) + 1, "0000")
I tried the code without the Format function but instead of incremented number 0010014 I get 00114
Can this help?
Sub Test()
Debug.Print IncrementProduct("0010001") //Prints 0010002
Debug.Print IncrementProduct("0010012") //Prints 0010013
Debug.Print IncrementProduct("0010099") //Prints 0010100
End Sub
Function IncrementProduct(code As String) As String
Dim manufacturerCode As String, padding As String, productCode As String
manufacturerCode = VBA.Left$(code, 3)
productCode = CInt(VBA.Right$(code, Len(code) - Len(manufacturerCode))) + 1
padding = Application.WorksheetFunction.Rept("0", 4 - Len(productCode))
IncrementProduct = manufacturerCode & padding & productCode
End Function
You can use a simple Format call fine, however the input needs to be explicitly converted to a Long first:
Function IncProductNumber(Value)
If IsNull(Value) Then
Let IncProductNumber = Null
Else
Let IncProductNumber = Format(CLng(Value) + 1, "0000000")
End If
End Function
Or, more generically, the desired padding could be inferred from the input:
Function IncTextNumber(Value)
If IsNull(Value) Then
Let IncTextNumber = Null
Else
Let IncTextNumber = Format(CLng(Value) + 1, String$(Len(Value), "0"))
End If
End Function
IncTextNumber("0123") will produce "0124", IncTextNumber("00999") will produce "01000" and so on.
Dim tempManProd As String, tempNumToInc As Integer
tempManProd = 'get the value you are wanting to increment
tempNumToInc = CInt(right(tempManProd, 4))
tempNumToInc = tempNumToInc + 1
'This will make sure that the 0s get added back to the front of the product
Do While (Len(tempManProd & "") + Len(tempNumToInc & "")) < 7
tempManProd = tempManProd & "0"
Loop
tempManProd = tempManProd & CStr(tempNumToInc)
I have a search form I creating in access with a code to search for keywords and then create a table with the results:
Like"*"&[FORMS]![Search_Form]![KW_Text]&"*"
WHich basically tells it to read the keyword i type in and pull up any matching results.
I would like to be able to type in multiple words, in the table containing all the data I have multiple keywords for each bit of data all separated by comas. So if I type in Manager it returns all results with the word Manager in it, I would like to be able to type in Manager, Supervisor and have it return all results for manager and all results for supervisor.
You can use the SPLIT() function in VBA to split the search string into an array, then For Each through the array to build up a search/filter string such as
(thing LIKE "*Manager*") OR (thing LIKE "*Supervisor*")
I use this code. It create a OR between your sting separated by a space. I put this processed string in an querydefs
Function CreateOr(MyCriteria As String, MyField As String) As String
Dim MyChar As String
Dim MyUniqueCriteria As String
Dim MyFinalCriteria As String
Dim I, j As Integer
j = 0
For I = 1 To Len(MyCriteria)
MyChar = Mid(MyCriteria, I, 1)
If MyChar = " " Then
If j = 0 Then
MyFinalCriteria = MyFinalCriteria & MyField & "=" & MyUniqueCriteria
Else
MyFinalCriteria = MyFinalCriteria & " or " & MyField & "=" & MyUniqueCriteria
End If
MyUniqueCriteria = ""
j = j + 1
Else
MyUniqueCriteria = MyUniqueCriteria & MyChar
End If
Next
CreateOr = MyFinalCriteria
End Function
Hope it help you