初めての投稿となります。
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を確認しようと思います。