In Windows Excel VBA,how to get JSON keys to pre-empt “Run-time error '438': Object doesn't support this property or method”?

后端 未结 1 881
借酒劲吻你
借酒劲吻你 2020-12-07 04:42

answering my own question here.
I have done some work with JSON in Excel VBA and lots of findings to post which I will do so in Q & A format https://stackoverflow.co

相关标签:
1条回答
  • 2020-12-07 05:02

    Answers to other stack overflow question that relate to working with parsed JSON objects use a mini-script approach and we can use this approach here. If we say we are running a Microsoft Windows edition of Excel VBA then we can use the Scripting Dictionary as found in the library Microsoft Scripting Runtime.

    We can create the Scripting.Dictionary in the Javascript, populate it with the keys of JSON object and also use the values as references to the subelements, and finallly pass back to VBA. In VBA, one can then use the Dictionary's Exists method to defend against missing keys. One can use the Dictionary's Count method to dimension other downstream variables. One can even use Dictionary's Item method to retrieve a subelement (one level down only).

    Thus,

    'Tools->References->
    'Microsoft Scripting Runtime
    'Microsoft Script Control 1.0;  {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx
    
    Option Explicit
    
    Private Function GetScriptEngine() As ScriptControl
        Static soScriptEngine As ScriptControl
        If soScriptEngine Is Nothing Then
            Set soScriptEngine = New ScriptControl
            soScriptEngine.Language = "JScript"
    
            soScriptEngine.AddCode "function getKeyValues(jsonObj) { " & _
                                  " var dictionary = new ActiveXObject(""Scripting.Dictionary""); " & _
                                  " var keys = new Array(); for (var i in jsonObj) { dictionary.add(i,jsonObj[i]); }; return dictionary; } "
    
    
        End If
        Set GetScriptEngine = soScriptEngine
    End Function
    
    
    Private Sub TestJSONParsingWithCallByName3()
    
        Dim oScriptEngine As ScriptControl
        Set oScriptEngine = GetScriptEngine
    
        Dim sJsonString As String
        sJsonString = "{'key1': 'value1'  ,'key2': { 'key3': 'value3' } }"
    
        Dim objJSON As Object
        Set objJSON = oScriptEngine.Eval("(" + sJsonString + ")")
    
        Dim dicKeys As Scripting.Dictionary
        Set dicKeys = oScriptEngine.Run("getKeyValues", objJSON)
    
        Debug.Assert dicKeys.Count = 2
    
        Debug.Assert TypeName(dicKeys.Item(dicKeys.Keys()(1))) = "JScriptTypeInfo"
        Stop
    
        If dicKeys.Exists("foobarbaz") Then
    
            '*** Next line WOULD throw "Run-time error '438': Object doesn't support this property or method" because "foobarbaz" is not a key
            '*** but is skipped because of defensive code.
            Debug.Assert VBA.CallByName(objJSON, "foobarbaz", VbGet)
    
        End If
    
    End Sub
    

    However, I have also discovered a wonderful alternative that requires no miniscript or Scripting.Dictionary. It will allow pre-empting of missing keys but has no collection class functionality. It uses a little known property of hasOwnProperty(). Thus,

    'Tools->References->
    'Microsoft Script Control 1.0;  {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx
    
    Option Explicit
    
    Private Sub TestJSONParsingWithCallByName4()
    
        Dim oScriptEngine As ScriptControl
        Set oScriptEngine = New ScriptControl
        oScriptEngine.Language = "JScript"
    
        Dim sJsonString As String
        sJsonString = "{'key1': 'value1'  ,'key2': { 'key3': 'value3' } }"
    
        Dim objJSON As Object
        Set objJSON = oScriptEngine.Eval("(" + sJsonString + ")")
    
        Debug.Assert objJSON.hasOwnProperty("key1")
        Debug.Assert objJSON.hasOwnProperty("key2")
    
        Dim objKey2 As Object
        Set objKey2 = VBA.CallByName(objJSON, "key2", VbGet)
    
        Debug.Assert objKey2.hasOwnProperty("key3")
    
    
        If objJSON.hasOwnProperty("foobarbaz") Then
    
            '*** Next line WOULD throw "Run-time error '438': Object doesn't support this property or method" because "foobarbaz" is not a key
            '*** but is skipped because of defensive code.
            Debug.Assert VBA.CallByName(objJSON, "foobarbaz", VbGet)
    
        End If
    
    End Sub
    
    0 讨论(0)
提交回复
热议问题