I have below function which is formatting my JSON, but email is not being formatted the way I like.
Current output for email is like this:
"emails": "TestEmail1@test.com",
but I am looking for this format instead:
"emails":[
{
"value":"testsac1@merck.com",
"type":"work",
"primary":true
}
],
How do I fix the code in VBA ?
Function GetRequestBody(requestType As String, Optional includeOptional As Boolean = False) As Object
Dim requestBody As Object
Set requestBody = CreateObject("Scripting.Dictionary")
If LCase(requestType) = "http return" Then
requestBody("status") = "<HTTP STATUS CODE>"
requestBody("raw") = "<JSON>"
requestBody("message") = "<HTTP RESPONSE>"
Set GetRequestBody = requestBody
Exit Function
ElseIf LCase(requestType) = "create user" Then
requestBody("schemas") = Array("ietf:params:scim:schemas:core:2.0:User", "urn:ietf:params:scim:schemas:extension:enterprise:2.0:User")
requestBody("userName") = "<REQ ID>"
Set requestBody("name") = CreateObject("Scripting.Dictionary")
With requestBody("name")
.Add "givenName", "<FIRST NAME>"
.Add "familyName", "<LAST NAME>"
End With
requestBody("displayName") = "<DISPLAY NAME>"
Set requestBody("emails") = CreateObject("Scripting.Dictionary")
With requestBody("emails")
.Add "value", "<WORK EMAIL>"
.Add "type", "work"
.Add "primary", "true"
End With
Set requestBody("roles") = CreateObject("Scripting.Dictionary")
Set requestBody("groups") = CreateObject("Scripting.Dictionary")
Set requestBody("urn:scim:schemas:extension:enterprise:1.0") = CreateObject("Scripting.Dictionary")
With requestBody("urn:scim:schemas:extension:enterprise:1.0")
Set .Item("manager") = CreateObject("Scripting.Dictionary")
.Item("manager")("managerId") = "<MANAGER ID>"
End With
If includeOptional Then
Set requestBody("urn:ietf:params:scim:schemas:extension:sap:user-custom-parameters:1.0") = CreateObject("Scripting.Dictionary")
With requestBody("urn:ietf:params:scim:schemas:extension:sap:user-custom-parameters:1.0")
.Add "dataAccessLanguage", "en"
.Add "dateFormatting", "MMM d, yyyy"
.Add "timeFormatting", "H:mm:ss"
.Add "numberFormatting", "1,234.56"
.Add "cleanUpNotificationsNumberOfDays", 0
.Add "systemNotificationsEmailOptIn", "true"
.Add "marketingEmailOptIn", "false"
.Add "isConcurrent", "true"
End With
End If
ElseIf LCase(requestType) = "create team" Then
requestBody("id") = "<TEAM ID>"
requestBody("displayName") = "<TEAM DESC>"
Set requestBody("members") = CreateObject("Scripting.Dictionary")
With requestBody("members")
.Add "type", "User"
.Add "value", " <USER ID> "
.Add "$ref", "/api/v1/scim/Users/<USER ID> "
End With
Set requestBody("roles") = CreateObject("Scripting.Dictionary")
If includeOptional Then
Set requestBody("urn:ietf:params:scim:schemas:extension:sap:group-custom-parameters:1.0") = CreateObject("Scripting.Dictionary")
With requestBody("urn:ietf:params:scim:schemas:extension:sap:group-custom-parameters:1.0")
.Add "admins", Array("User1")
.Add "moderators", Array("User1", "User2")
End With
End If
ElseIf LCase(requestType) = "add user" Then
requestBody("type") = "User"
requestBody("value") = " <USER ID> "
requestBody("$ref") = "/api/v1/scim/Users/<USER ID>"
ElseIf LCase(requestType) = "add team" Then
requestBody("value") = "<TEAM ID>"
requestBody("display") = "<TEAM TEXT>"
requestBody("$ref") = "/api/v1/scim/Groups/<TEAM ID>"
ElseIf LCase(requestType) = "add email" Then
requestBody("value") = "<EMAIL>"
requestBody("type") = "<TYPE>"
requestBody("primary") = "<VALUE>"
End If
Set GetRequestBody = requestBody
End Function
Using Tim Hall's JSON tool; (https://github.com/VBA-tools/VBA-JSON)
Sub TestJSON()
Dim data As Dictionary, email As Dictionary, strJSON As String
Set data = New Dictionary
Set email = New Dictionary
With data
.Add "value", "testsac1@merck.com"
.Add "type", "work"
.Add "primary", True
End With
email.Add "emails", data
strJSON = JsonConverter.ConvertToJson(ByVal email)
MsgBox strJSON
End Sub
The result is;
{"emails":{"value":"testsac1@merck.com","type":"work","primary":true}}