jsonで取得したファイルがパース後に開けない。(のオブジェクトはプロパティまたはメソッドをサポートしていません。)

初めての投稿となります。

kintoneよりRestAPIで取得(Json)したデータをVBA側でエクセルに入力する処理を行いたいのですが、取得したJSONデータをパースしたオブジェクトにてエラーとなります。

エラー内容:このオブジェクトはプロパティまたはメソッドをサポートしていません。

Public Function fncInfoGet() As Boolean

    '変数宣言
  Dim strNo          As String
    Dim strRecNo         As String
    Dim strGetJson       As String
    Dim strIDPW          As String
  
    Dim parser          As New JsonParser
    Dim objJson         As Object
    Dim jsObj           As New JsonObject

  fncInfoGet = False
    
  On Error GoTo fncInfoGet_Err
 
    strRecNo = Worksheets(CST_MAIN).Range(CST_MAIN_レコード番号).Value
  strauNo = Worksheets(CST_MAIN).Range(CST_MAIN_番号).Value

    strID = strRecNo
  strAPP = CST_テストTBL
    
  strIDPW = "" 'kintoneのログイン情報
    
  If fncKintoneGet_ID(strAPP, strID, strIDPW, strGetJson) = False Then      
        MsgBox ("エラー発生 fncKintoneGet_ID " & vbCrLf & strGetJson)
       
        Exit Function
  End If
    
  Set objJson = parser.Parse(strGetJson)
  
    'ここでエラーとなります
  Set jsObj = objJson("record")(1)
        
  If fncSetDataSet(jsObj) = False Then
        Set objJson = Nothing
        Set jsObj = Nothing
        Exit Function
    End If
  
  fncInfoGet = True
    
    Exit Function
fncInfoGet_Err:
  MsgBox "エラー発生 fncInfoGet_Err(" & Err.Description & ")" & vbCrLf & strGetJson

    Set objJson = Nothing

End Function

 

JSONのデータ例は下記のとおりです。

{"record":

    {"レコード番号":{"type":"RECORD_NUMBER","value":"1"},

  "番号":{"type":"SINGLE_LINE_TEXT","value":"1234567890"},

  "特定番号":{"type":"SINGLE_LINE_TEXT","value":"1234567890123456789012"},

  "更新者":{"type":"MODIFIER","value":{"code":"test","name":"山田"}},

  "作成者":{"type":"CREATOR","value":{"code":"test","name":"山田"}},

    "お客さま番号":{"type":"SINGLE_LINE_TEXT","value":"1234567890"},

    "$revision":{"type":" __REVISION__","value":"1"},

    "更新日時":{"type":"UPDATED_TIME","value":"2022-09-29T07:49:00Z"},

    "作成日時":{"type":"CREATED_TIME","value":"2022-09-29T07:49:00Z"},

    "$id":{"type":" __ID__","value":"1"}}

}

 

 

JSONのパース処理はオリジナルクラスでの処理となっており、その部分は他ツールにて動作確認済みです。

 

objJsonが定義されていないというようなエラーに見えるのですが、対処方法が不明です。

宜しくお願い致します。

 

jiirii様

    'ここでエラーとなります
    Set jsObj = objJson("record")(1)

ここが,

  Set jsObj = objJson(1)("record")

こうかもしれません.
古い情報ですが,下記を参考にしました.
【VBA】VBAでjsonのパーサを作ってみよう

回答ありがとうございます。

変更して実行しましたが、エラー内容は変わらずでした。。

objJsonの方をTypeNameで調べるとJsonObjectとなっており、

    Set objJson = parser.Parse(strGetJson)

ではエラーは出ないので、格納はされていると思うのですが。。。

jiirii様

①objJsonをdebug.printしてみる
②jsObjをobject型で定義してみる
(②はできないのかもしれませんが)
このあたりを確認すると,もう少し具体的な対策がでてくるかもしれません.

TO様

ありがとうございます。

①を実行したところ、そもそもイミディエイトウィンドウに何も表示されませんでした(""部分も含めて)。

  Debug.Print "objJson = " & objJson

objJsonが定義されていない、ということでしょうか。

objJsonをstrGetJsonなどに置き換えると、Debug.Printは実行され、strGetJsonにはデータが入っていることを確認しています。

 

jiirii様

Debug.Print"objJson = "& objJson

コード及び参考情報から,objJsonは配列になっているはずで,
debug.printでobjJsonだけを見ようとするとエラーになると思いましたが,エラーにはなっていませんか?
また,

Debug.Print objJson(1)("record")

これだとエラーになりますか?
これが問題なく表示されるのであれば,どちらかというとJsonObjectクラスの定義に問題があるかもしれません.

TO様

 

再三ありがとうございます。

Debug.PrintobjJson(1)("record")

こちらを実行したところ、この箇所にてエラーとなります。

エラー内容は

 Set jsObj = objJson(1)("record")

で発生するものと同様のものです。

 

jiirii様

そこでエラーになるということは,
object型であるobjJsonに何も入っていない(配列にもなっていない)ということになるので,
動作確認済みとのことですが,

parser.Parse(strGetJson)

このparser(JsonParserクラス)の挙動を追ったほうが良いかと思います.
確認できるかわかりませんが,例えば

debug.print parser.Parse(strGetJson)(1)("record")

で中身が適切にみられるか,またはparser.Parse内をブレークポイントを置きながら値の流れを見る,などでしょうか.

TO様

 

ありがとうございます。

Parse処理の箇所を再度確認しておりました。

Option Explicit

'##########################
'JsonParser
'Jsonパース処理
'##########################

Private m_js As Object
' ********************
'コンストラクタ
' ********************
Public Sub Class_Initialize()
    Set m_js = CreateObject("ScriptControl")
    m_js.Language = "JScript"
    
    'JsonをevalするJavascript
    m_js.AddCode "function jsonParse(str) {return eval('(' + str + ')'); };"
    
    'Jsonからキーの配列を取得するJavascript
    m_js.AddCode "function getKeys(h) { var keys=[]; for(var k  in h){keys.push(k);} return keys; };"
    
    'Jsonが配列かどうかを確認するJavascript
    m_js.AddCode "function isArray(o) {return o instanceof Array; };"
        

End Sub

' ********************
'デストラクタ
' ********************
Private Sub Class_Terminate()
  Set m_js = Nothing
End Sub

' *******************
'パース処理呼び出し
'
'Argument : Jsonの形式になっている文字列(String)
'Return   : Collection(JsonObject)もしくはJsonObject
'           引数がJson形式ではなかった場合はNothing
' ********************
Public Function Parse(ByVal strJson As String) As Object

    Dim json        As Object
    
    On Error GoTo ParseError
    
    Set json = m_js.codeobject.jsonParse(strJson)

    On Error GoTo 0
    
    'Valueを解析した結果がJScriptTypeInfoかどうかを判定する
    'JScriptTypeInfo以外の場合はNothingを返す
    If IsJson(json) Then
        If IsJsonArray(json) Then
            Set Parse = JsonArrayToCollection(json)
        Else
            Set Parse = JsonToDictionary(json)
        End If
    Else
        Set Parse = Nothing
    End If
    
    Exit Function
    
ParseError:

    Debug.Print Err.Description
    Set Parse = Nothing
    
End Function

' ********************
'Jsonの配列をCollectionに変換する
'Argument : Jsonの配列(JScriptTypeInfo)
'Return   : Key:Jsonで使用されているキー Value:JsonObjectのCollection
' ********************
Private Function JsonArrayToCollection(ByVal json As Object) As Collection

    Dim col As New Collection
    Dim Key As Variant
    Dim objJson As Object
    Dim varJson As Variant
    Dim jsonObj As JsonObject
    Dim jsonData As Dictionary
    
    For Each Key In GetKeys(json)
    
        On Error GoTo VariantPattern
        Set objJson = GetObject(json, Key)
        
        If IsJsonArray(objJson) Then
            '配列だった場合は再帰させる
            Call col.Add(JsonArrayToCollection(objJson), Key)
        
        Else
            '一要素だった場合は、JsonObjectをCollectionに追加する
            Call col.Add(JsonToDictionary(objJson), Key)
        End If
        
        GoTo Continue

VariantPattern:
    On Error GoTo 0
    varJson = GetValue(json, Key)
    Set jsonObj = New JsonObject
    Set jsonData = New Dictionary
    
    Call jsonData.Add(Key, varJson)
    Call jsonObj.Init(jsonData)
    Call col.Add(jsonObj, Key)
    
    Resume Continue
    
Continue:
    Next
    
    On Error GoTo 0
    
    Set JsonArrayToCollection = col
    
End Function

' ********************
'Jsonの配列をDictionaryに変換する
'Argument : Jsonの配列(JScriptTypeInfo)
'Return   : Key:Jsonで使用されているキー Value:JsonObjectのCollection
' ********************
Private Function JsonToDictionary(ByVal json As Object) As JsonObject

    Dim jsonDictionary  As New Dictionary
    Dim col             As New Collection
    Dim collectionValue As Variant
    Dim jsonObj         As New JsonObject
    Dim Key             As Variant
    Dim objJson         As Object
    Dim varJson         As Variant
    Dim obj             As Object
    Dim var             As Variant
    
    For Each Key In GetKeys(json)
        On Error GoTo VariantPattern
        Set objJson = GetObject(json, Key)
        
        On Error GoTo 0
        
        If IsJsonArray(objJson) Then
            '配列だった場合はKey:Jsonのキー value:Collection(JsonObject)となるDictionaryを作成
            'Collection(jsonObject)の作成
            
            For Each collectionValue In objJson
                'Collection作成中にJsonの配列が現れた場合は再帰させる
                If IsJson(collectionValue) Then
                    Call col.Add(JsonToDictionary(collectionValue))
                    
                Else
                    Call col.Add(collectionValue)
                
                End If
            Next
            
            Call jsonDictionary.Add(Key, col)
        Else
            On Error GoTo ObjectPattern
            var = GetValue(objJson, Key)
            On Error GoTo 0
            
            Call jsonDictionary.Add(Key, var)
            
            GoTo Continue
        End If
        
        GoTo Continue

ObjectPattern:
        Call jsonDictionary.Add(Key, JsonToDictionary(objJson))
        Resume Continue
        
VariantPattern:
        On Error GoTo 0
        Call jsonDictionary.Add(Key, GetValue(json, Key))
        Resume Continue

Continue:
    Next
    
    '作成し終わったDictionaryでJsonObjectを作る
    Call jsonObj.Init(jsonDictionary)
    
    Set JsonToDictionary = jsonObj
                
End Function

' ********************
'配列チェック
'Argument : Jsonの配列(JScriptTypeInfo)
'Return   : 引数が配列ならばTrue、配列でなければFalse
' ********************
Private Function IsJsonArray(ByVal json As Object) As Boolean

    IsJsonArray = CallByName(m_js.codeobject, "isArray", VbMethod, json)

End Function

' ********************
'キー取得
'Argument : Jsonの配列(JScriptTypeInfo)
'Return   : 引数のキーの配列
' ********************
Private Function GetKeys(ByVal json As Object) As Object

    Set GetKeys = CallByName(m_js.codeobject, "getKeys", VbMethod, json)
    
End Function

'Json判定
Private Function IsJson(ByVal obj) As Boolean

    IsJson = TypeName(obj) = "JScriptTypeInfo"
  
End Function

'Jsonからキーのオブジェクトを取得
Private Function GetObject(ByVal json As Object, ByVal Key As Variant) As Object

    Set GetObject = CallByName(json, Key, VbGet)
    
End Function

'Jsonからキーの内容取得
Private Function GetValue(ByVal json As Object, ByVal Key As Variant) As Variant

    GetValue = CallByName(json, Key, VbGet)
    
End Function

 

元のコードの下記箇所にて、

Parse処理ではNothingが設定される分岐となっており、当該エラーとなっているようです。

SetobjJson=parser.Parse(strGetJson)

 

引数で渡しているstrGetJsonは質問欄に記載の配列(1レコード)が入っているのですが、

IsJsonArrayでFalseが返っていることまで確認しました。

 

jiirii

試しにですが、対象になっているJSON

{"record":
   〜
}

を、

[{"record":
   〜
}]

として実行してみていただけませんか?
前後を[]でかこって、連想配列ではない普通の配列にしています。
コード上は連想配列(配列でない)でも動くようになっているようにみえるので、ここではないかもしれません。

これでもうまくいかなければ、JSONはどちらでもよいので、functionのJsonArrayToCollection、JsonToDictionaryで共通しているkeyなどが適切に取得できているか、などを追っていくと良いと思います。

TO様

 

ありがとうございます。

ご指定の[]で囲う形で実行しても結果は変わらずでした。

Parse処理を止めながら進めていると、JsonToDictionary内のvarに値を入れる箇所にて取得できていないようでした。

var=GetValue(objJson, Key)

Debug.Print GetValue(objJson, Key)

ここが原因となっていると思うのですが、おかしいところはありますでしょうか。。

 

jiirii

コードにおかしいところはみうけられません。
ここではcallbynameでjsonからkeyでデータをgetしているので、
問題ないとは思うのですが、念のためにこの段階でkeyがちゃんと取得できているのか確認してみてください。
また、いちど簡単なison(確実に読み込めるもの)で試すのも一向かと思います。

TO様

 

ありがとうございます。

jsonはkintoneから取得したものですので、問題ないと考えておりましたが、

一度試させていただきます。

ありがとうございました。

 

jiirii様

jsonについては,実績のあるもので試す(例えば参照先のサイトにあるテスト用JSONなど)ことができれば,
問題のさらなる切り分けができると考えた次第です.

もし,簡単なJSONでためす機会があれば,下記のように直接文字列として入れてみて,
どうなるか確認するのが良いかと思います.
(実例があるので)

Set objJson = parser.Parse("[{""hoge"":{ ""piyo"":{""fugapiyo"":[{""foo"":1},{""bar"":2}]}, ""fuga"":[3,4], ""hogepiyo"":[5,6], ""hogefuga"":7 }}]")

上記は下記サイトから参照しています.
https://outofmem.hatenablog.com/entry/2013/10/08/063340

参考になれば幸いです.

TO様

 

ありがとうございます。

JSONを例で挙げていただいた文字列として実行しても同様のエラーが表示されました。

objJson(1)(“hoge”)が失敗しているのは間違いないようですので、再度parserを確認しようと思います。