お世話になります。
VBAからkintoneの指定アプリにアクセスし、そこから取得したデータをExcelに反映したいのですが、
『エラー番号438 オブジェクトは、このプロパティまたはメソッドをサポートしていません』
とエラーが表示され値が反映できません。
解決方法を教えて頂ければ幸いです。
Option Explicit
Const DOMAIN_NAME As String = “XXXXXXXX.cybozu.com”
Const BASE_URL As String = “https://” & DOMAIN_NAME & “/k/v1/” 'kintoneのURL
Const APP_ID As String = “XXX”
Const API_TOKEN As String = “XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX” 'APIトークン
Const cellFromRecNumber = “A2”
Const cellFromRecNumber2 = “B4”
Dim strURL As String ’ アクセス先URL
Dim objHttpReq As Object ’ XMLHTTP オブジェクト
Dim strJSON As String ’ レスポンスで受け取るJSONデータ
Dim objJSON As Object ’ レスポンスのJSON文字列をパースした情報を格納
Dim strFromRecNumber As String ’
Dim strToRecNumber As String ’
Dim strQuery As String ’
Dim record As Variant ’
Dim rep As Variant ’
Dim js As Object
Dim strFunc As String
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range(cellFromRecNumber)) Is Nothing Then
Exit Sub
Else
Set js = CreateObject(“ScriptControl”)
js.Language = “JScript”
strFunc = “function jsonParse(s) { return eval(‘(’ + s + ‘)’); }”
js.AddCode strFunc
strFromRecNumber = Range(cellFromRecNumber)
strQuery = “Userid = “”” & strFromRecNumber & “”“”
strQuery = js.CodeObject.encodeURIComponent(strQuery)
strURL = BASE_URL & “records.json?&app=” & APP_ID & “&query=” & strQuery
Set objHttpReq = CreateObject(“MSXML2.XMLHTTP”)
objHttpReq.Open “GET”, strURL, False
objHttpReq.setRequestHeader “Host”, DOMAIN_NAME & “:443”
objHttpReq.setRequestHeader “X-Cybozu-API-Token”, API_TOKEN
objHttpReq.setRequestHeader “If-Modified-Since”, “Thu, 01 Jun 1970 00:00:00 GMT”
objHttpReq.send (Null)
If objHttpReq.Status <> 200 Then
MsgBox (“Send:検索エラー”)
End
End If
strJSON = objHttpReq.responseText 'レスポンス情報を変数に格納する
strJSON = Replace(strJSON, “”“$revision”“:”, “”“kintone_revision”“:”) ’ $revisionはVBAの変数名として使えないため置き換え
Set objJSON = js.CodeObject.jsonParse(strJSON) ’ レスポンスで取得したJSONをパース
For Each record In objJSON.records
’ 各セルにレコードの値を出力する◆◆◆ここでエラー◆◆◆
Worksheets(1).Range(cellFromRecNumber2).Value = record.Officename.Value ’ 見積書番号
Next record
’ オブジェクトを解放
Set objHttpReq = Nothing
Set js = Nothing
End If
End Sub