我正在使用 Excel VBA 并调用外部 REST API。该调用需要 json 格式的有效负载。我在创建 json 格式时遇到问题。
{
"customerContext": {
"identifiers": [
{
"apiName": "email",
"value": "<a href="https://stackoverflow.com/cdn-cgi/l/email-protection" class="__cf_email__" data-cfemail="96f2f7e3e2e6e3e4f3d6eff7fef9f9b8f5f9fb" rel="noreferrer noopener nofollow">[email protected]</a>"
}
],
"baseTouchpointUri": "physical://webinar"
},
"activities": [
{
"propositionCode": "Homepage",
"activityTypeCode": "ATTEND_ROADSHOW",
"timestamp": "2019-12-27T10:31:40Z"
}
]
}
vba代码如下:
Sub UploadOfflineInteraction()
Dim apiName As String
Dim apiName_value As String
Dim baseTouchpoint As String
Dim propositionCode As String
Dim activityTypeCode As String
Dim timestamp As String
Dim NoOfRows As Integer
Dim i As Integer
ActiveWorkbook.Worksheets("Data").Activate
NoOfRows = ActiveWorkbook.Worksheets("Data").Range("A2").End(xlDown).row
For i = 1 To NoOfRows
apiName = ActiveWorkbook.Worksheets("Data").Cells(i, 1).Value
apiName_value = ActiveWorkbook.Worksheets("Data").Cells(i, 2).Value
baseTouchpoint = ActiveWorkbook.Worksheets("Data").Cells(i, 3).Value
propositionCode = ActiveWorkbook.Worksheets("Data").Cells(i, 4).Value
activityTypeCode = ActiveWorkbook.Worksheets("Data").Cells(i, 5).Value
timestamp = ActiveWorkbook.Worksheets("Data").Cells(i, 6).Value
Dim tid
tid = SentOfflineInteraction(apiName, apiName_value, baseTouchpoint, propositionCode, activityTypeCode, timestamp)
Next i
End Sub
Function SentOfflineInteraction(apiName As String, apiName_value As String, _
baseTouchpoint As String, propositionCode As String, _
activityTypeCode As String, timestamp As String) As String
Dim c As Collection
Dim d As Dictionary
Dim e As Dictionary
Dim f As Dictionary
Dim json As String
Set c = New Collection
Set d = New Dictionary
Set e = New Dictionary
Set f = New Dictionary
d.Add "propositionCode", propositionCode
d.Add "activityTypeCode", activityTypeCode
d.Add "timestamp", timestamp
c.Add d
f.Add "activities", c
Dim c1 As Collection
Dim d1 As Dictionary
Dim e1 As Dictionary
Dim f1 As Dictionary
Set c1 = New Collection
Set d1 = New Dictionary
Set e1 = New Dictionary
Set f1 = New Dictionary
d1.Add "apiName", apiName
d1.Add "value", apiName_value
c1.Add d1
f1.Add "identifiers", c1
Dim c2 As Collection
Dim d2 As Dictionary
Dim e2 As Dictionary
Dim f2 As Dictionary
Set c2 = New Collection
Set d2 = New Dictionary
Set e2 = New Dictionary
Set f2 = New Dictionary
d2.Add f1
d2.Add "baseTouchpointUri", baseTouchpoint
c2.Add d2
f2.Add "customerContext", c2
Dim c3 As Collection
Dim d3 As Dictionary
Dim e3 As Dictionary
Dim f3 As Dictionary
Set c3 = New Collection
Set d3 = New Dictionary
Set e3 = New Dictionary
Set f3 = New Dictionary
d3.Add f2
d3.Add f1
c3.Add d3
json = JsonConverter.ConvertToJson(ByVal c3)
Debug.Print json
End Function
我面临的问题是如何创建这个 json 有效负载。以下结构在 d2 处失败。Add f1
你能让我知道如何构建这个 json
最佳答案
使用一些辅助函数来简化构造:
Sub UploadOfflineInteraction()
Dim i As Long, cntxt As Object, act As Object, o As Object
With ActiveWorkbook.Worksheets("Data")
For i = 1 To .Cells(.rows.Count, 1).End(xlUp).Row
With .rows(i)
Set cntxt = jsonobject("identifiers", _
jsonarray(jsonobject("apiName", .Cells(1).Value, _
"value", .Cells(2).Value)), _
"baseTouchpointUri", .Cells(3).Value)
Set act = jsonarray(jsonobject("propositionCode", .Cells(4).Value, _
"activityTypeCode", .Cells(5).Value, _
"timestamp", .Cells(6).Value))
Set o = jsonobject("customerContext", cntxt, "activities", act)
Debug.Print JsonConverter.ConvertToJson(o, 2)
End With
Next i
End With
End Sub
'return a dictionary given a paramarray of key_1,value_1,...,key_n,value_n
Function jsonobject(ParamArray keyvals()) As Object
Dim rv As Object, n As Long
Set rv = CreateObject("scripting.dictionary")
For n = LBound(keyvals) To UBound(keyvals) Step 2
rv.Add keyvals(n), keyvals(n + 1)
Next n
Set jsonobject = rv
End Function
'return a collection from a paramarray of values
Function jsonarray(ParamArray vals()) As Collection
Dim rv As New Collection, n As Long
For n = LBound(vals) To UBound(vals)
rv.Add vals(n)
Next n
Set jsonarray = rv
End Function
关于json - Excel VBA 创建 json 有效负载,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/59570414/