1. 技术文章
  2. Returning Null JSON Throwing Type Mismatch Error in VBA

Returning Null JSON Throwing Type Mismatch Error in VBA

由 廉价感情. 提交于 2019-11-27 09:22:56

Working with JSON files is much easier (IMHO) if you understand how the JsonConverter processes the JSON into a compound object. Let's look at a simple JSON format (taken from this useful site):

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

The JsonConverter maps each of these data items into their VBA counterparts.

"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

So now we can do useful things with your JSON example, such as determine how many entires are in your "issues" array by

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

Each of the entries in your "issues" array is actually a compound object itself, so it's a Dictionary. We could, therefore, do something like this:

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

Of course, the "fields" section of this single issue is itself another Dictionary. So stacking up the dictionary references we can do this too:

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

All of this is background, hopefully to make it easier on accessing members of a JSON structure. Your real question is on handling NULLs. If the actual value of a field is set to null (see the above sample), then you check it like so

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

A couple of other side notes before we put it all together:

  1. Always use Option Explicit
  2. Avoid Select and Activate
  3. Always define and set references to all Workbooks and Sheets

In the example below, you'll see that I assumed you had to check each field for Null. That is best accomplished by isolating that check in a subroutine rather than over-mess your code with a long string of If statements. The advantage of the code example below is that you don't have to hard-code the number of issues because your logic can detect how many there are.

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

Fix

This is what I did to get this to work:

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

You may get JSON data into arrays as shown in the example code below. Import JSON.bas module into the VBA project for JSON processing.

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
标签
json
vba
excel-vba
jsonparser
excel
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!