json - 在 VBA 中返回空 JSON 引发类型不匹配错误

Question

问题

描述

我目前遇到了一个问题，即我返回的 JSON 的字段为空。

在下面的代码中，我发现大多数字段都有一个受理人，而在另一个级别的受理人有一个 displayName。我还发现有些东西没有受让人。当这种情况发生时（这可能也会发生在其他字段上，我只是以此为例）它会删除额外的层次结构级别，并且实际路径（如下所示）将被更改。

问题

有没有一种简单的方法来迭代这个响应，并将空值设置为空白？

Set Json = JsonConverter.ParseJson(MyRequest.ResponseText)

不过，这并不能真正帮助我实现自动化。请注意 [下面] 我在其中列出了两次组件，因为我不知道如何遍历该数据并根据需要填充该字段多次拉回该字段。Aka 我知道有两个组件，但它只带回一个组件，所以我不得不复制该代码以使其正常工作（我很抱歉复制）。

代码片段

我的代码运行良好，直到它达到空值，然后它抛出一个错误。

''''''''
' Loop '
''''''''

    For i = 0 To 40
    
'        ActiveSheet.Cells(i + 1, 1) = Json("issues")(i + 1)("fields")("issuetype")("name")
'        ActiveSheet.Cells(i + 1, 2) = Json("issues")(i)("key")
'        ActiveSheet.Cells(i + 1, 3) = Json("issues")(i + 1)("fields")("summary")
'        ActiveSheet.Cells(i + 1, 4) = Json("issues")(i + 1)("fields")("status")("name")
         ActiveSheet.Cells(i + 1, 5) = Json("issues")(i + 1)("fields")("assignee")
         ActiveSheet.Cells(i + 1, 5) = Json("issues")(i + 1)("fields")("assignee")("displayName")
'        ActiveSheet.Cells(i + 1, 6) = Json("issues")(i + 1)("fields")("customfield_13301")
'        ActiveSheet.Cells(i + 1, 7) = Json("issues")(i + 1)("fields")("components")(1)("name")
'        ActiveSheet.Cells(i + 1, 8) = Json("issues")(i + 1)("fields")("components")(2)("name")
'        ActiveSheet.Cells(i + 1, 9) = Json("issues")(i + 1)("fields")("customfield_13300")
'        ActiveSheet.Cells(i + 1, 10) = Json("issues")(i + 1)("fields")("customfield_10002")
    Next i

JSON

显然，出于隐私原因，我不得不删除一些内容，但这将受让人显示为空。带有“displayName”的 JSON 只是将 null 转换为 Array 并在其下有更多字段。

{
"expand": "schema,names",
"startAt": 0,
"maxResults": 50,
"total": 52,
"issues": [
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{
"expand": "operations,versionedRepresentations,editmeta,changelog,renderedFields",
"id": "92110",
"self": "",
"key": "",
"fields": {
"customfield_13100": null,
"fixVersions": [],
"customfield_13500": null,
"customfield_11200": null,
"resolution": null,
"customfield_13502": null,
"customfield_13501": null,
"lastViewed": null,
"customfield_12000": null,
"customfield_12002": null,
"customfield_12001": null,
"priority": {},
"customfield_10100": null,
"customfield_10101": null,
"customfield_12003": null,
"customfield_12402": null,
"labels": [],
"customfield_11303": null,
"customfield_11305": null,
"customfield_11306": null,
"aggregatetimeoriginalestimate": null,
"timeestimate": null,
"versions": [],
"issuelinks": [],
"assignee": null,
"status": {},
"components": [],
"customfield_13200": null,
"customfield_13600": null,
"customfield_12900": null,
"aggregatetimeestimate": null,
"creator": {},
"customfield_14000": null,
"subtasks": [],
"customfield_14400": null,
"reporter": {},
"customfield_12101": null,
"customfield_12100": null,
"aggregateprogress": {},
"customfield_14401": null,
"customfield_14402": null,
"customfield_12500": null,
"customfield_13702": null,
"customfield_13704": null,
"customfield_13703": null,
"customfield_11802": null,
"progress": {},
"votes": {},
"issuetype": {},
"timespent": null,
"project": {},
"customfield_13300": null,
"aggregatetimespent": null,
"customfield_13302": null,
"customfield_13301": null,
"customfield_13700": null,
"customfield_11400": null,
"resolutiondate": null,
"workratio": -1,
"watches": {},
"created": "2017-07-21T08:04:42.000-0500",
"customfield_14102": null,
"customfield_10020": null,
"customfield_12200": null,
"customfield_14100": null,
"customfield_14101": null,
"customfield_12600": null,
"customfield_14500": null,
"customfield_10300": null,
"customfield_10016": null,
"customfield_13405": null,
"customfield_10017": null,
"customfield_13800": null,
"customfield_10018": null,
"customfield_10019": null,
"customfield_13409": null,
"updated": "2017-08-10T15:29:37.000-0500",
"timeoriginalestimate": null,
"description": null,
"customfield_10011": null,
"customfield_10012": null,
"customfield_13401": null,
"customfield_13400": null,
"customfield_10013": null,
"customfield_10014": null,
"customfield_11500": "{}",
"customfield_10015": null,
"customfield_13514": null,
"summary": "",
"customfield_14200": null,
"customfield_10000": null,
"customfield_13511": null,
"customfield_12301": null,
"customfield_10001": null,
"customfield_12300": null,
"customfield_10002": "1|i021pe:5z",
"customfield_13510": null,
"customfield_13513": null,
"customfield_10003": [],
"customfield_12302": null,
"customfield_10004": null,
"customfield_13504": null,
"customfield_13503": null,
"customfield_11600": null,
"customfield_13506": null,
"environment": null,
"customfield_13901": null,
"customfield_13505": null,
"customfield_13508": null,
"duedate": null,
"customfield_13509": null
}
},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{},
{}
]
}

附加数据

我查看了 Raw 文件，只是想看看是否有任何不同（与我的 JSON Formater Plugin for Chrome 中的不同），这就是它的样子：

"assignee":null,

Answer 1

如果您了解 JsonConverter 如何将 JSON 处理为复合对象，则使用 JSON 文件会容易得多（恕我直言）。让我们看一个简单的 JSON 格式（取自这个有用的网站）：

{
  "array": [
    1,
    2,
    3
  ],
  "boolean": true,
  "null": null,
  "number": 123,
  "object": {
    "a": "b",
    "c": "d",
    "e": "f"
  },
  "string": "Hello World"
}

JsonConverter 将这些数据项中的每一个映射到它们的 VBA 对应项中。

"array"   maps to Collection   (anytime you see the square brackets [])
"boolean" maps to Boolean
"null"    maps to Null
"number"  maps to Double
"object"  maps to Dictionary   (anytime you see the curly braces {})
"string"  maps to String

"issues"所以现在我们可以用您的 JSON 示例做一些有用的事情，例如通过以下方式确定您的数组中有多少个整数

Dim issues As Collection
Set issues = schema("issues")
Debug.Print issues.Count

数组中的每个条目"issues"实际上都是一个复合对象本身，所以它是一个Dictionary. 因此，我们可以这样做：

Dim issue As Variant
For Each issue In issues
    If issue.Exists("id") Then
        Debug.Print "id = " & issue("id")
    End If
Next issue

当然，"fields"这首单曲的部分issue本身就是另一个Dictionary。所以堆叠字典引用我们也可以这样做：

Debug.Print "field summary is " & issue("fields")("summary")

所有这些都是背景，希望能够更轻松地访问 JSON 结构的成员。你真正的问题是处理NULLs。如果字段的实际值设置为null（参见上面的示例），那么您可以像这样检查它

If IsNull(issue("fields")("customfield_13500")) Then ...

在我们把它们放在一起之前，还有一些其他的旁注：

1. 始终使用Option Explicit
2. 避免Select和Activate
3. 始终定义和设置对所有工作簿和工作表的引用

在下面的示例中，您会看到我假设您必须检查每个字段的Null. 这最好通过在子例程中隔离检查来完成，而不是用一长串If语句过度混淆您的代码。下面代码示例的优点是您不必对问题的数量进行硬编码，因为您的逻辑可以检测问题的数量。

Option Explicit

Sub main()
    Dim schema As Object
    Set schema = GetJSON("C:\dev\junk.json")

    Dim thisWB As Workbook
    Dim destSH As Worksheet
    Set thisWB = ThisWorkbook
    Set destSH = thisWB.Sheets("Sheet1")

    Dim anchor As Range
    Set anchor = destSH.Range("A1")

    Dim issues As Collection
    Set issues = schema("issues")

    Dim i As Long
    Dim issue As Variant
    For Each issue In issues
        If issue.Exists("id") Then
            SetCell anchor.Cells(1, 1), issue("fields")("issuetype")("name")
            SetCell anchor.Cells(1, 2), issue("key")
            SetCell anchor.Cells(1, 3), issue("fields")("summary")
            '--- if you're not sure if the "name" field is there,
            '    then remember it's a Dictionary so check with Exists
            If issue("fields")("status").Exists("name") Then
                SetCell anchor.Cells(1, 4), issue("fields")("status")("name")
            Else
                SetCell anchor.Cells(1, 4), vbNullString
            End If
            SetCell anchor.Cells(1, 5), issue("fields")("assignee")
            SetCell anchor.Cells(1, 6), issue("fields")("customfield_13301")
            '--- possibly get the Count and iterate over the exact number of components
            For i = 0 To issue("fields")("components").Count - 1
                SetCell anchor.Cells(1, 7), issue("fields")("components")(i)("name")
            Next i
            SetCell anchor.Cells(1, 9), issue("fields")("customfield_13300")
            SetCell anchor.Cells(1, 10), issue("fields")("customfield_10002")
            Set anchor = anchor.Offset(1, 0)
        End If
    Next issue
End Sub

Function GetJSON(ByVal filename As String) As Object
    '--- first ingest the JSON file and get it parsed
    Dim fso As FileSystemObject
    Dim jsonTS As TextStream
    Dim jsonText As String
    Set fso = New FileSystemObject
    Set jsonTS = fso.OpenTextFile(filename, ForReading)
    jsonText = jsonTS.ReadAll
    Set GetJSON = JsonConverter.ParseJson(jsonText)
End Function

Private Sub SetCell(ByRef thisCell As Range, ByVal thisValue As Variant)
    If IsNull(thisValue) Then
        thisCell = vbNullString
    Else
        thisCell = thisValue
    End If
End Sub

Answer 2

您可以将 JSON 数据放入数组中，如下面的示例代码所示。将 JSON.bas模块导入VBA 项目以进行 JSON 处理。

Sub Test()

    ' Put sourse JSON string to "\source.json" file, and save as ANSI or Unicode

    Dim sJSONString As String
    Dim vJSON As Variant
    Dim sState As String
    Dim aData()
    Dim aHeader()

    sJSONString = ReadTextFile(ThisWorkbook.Path & "\source.json", -2)
    JSON.Parse sJSONString, vJSON, sState
    vJSON = vJSON("issues")
    JSON.ToArray vJSON, aData, aHeader
    With Sheets(1)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With

End Sub

Sub OutputArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Sub Output2DArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize( _
                UBound(aCells, 1) - LBound(aCells, 1) + 1, _
                UBound(aCells, 2) - LBound(aCells, 2) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Function ReadTextFile(sPath As String, lFormat As Long) As String
    ' lFormat -2 - System default, -1 - Unicode, 0 - ASCII
    With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 1, False, lFormat)
        ReadTextFile = ""
        If Not .AtEndOfStream Then ReadTextFile = .ReadAll
        .Close
    End With
End Function

Answer 3

使固定

这就是我为使其工作所做的工作：

If IsNull(Json("issues")(i + 1)("fields")("components")) Then
    ActiveSheet.Cells(i + 1, 5).Value = ""
Else
    ActiveSheet.Cells(i + 1, 7) = Json("issues")(i + 1)("fields")("components")(1)("name")
End If