Отражение данных кинтона в Excel - PullRequest
0 голосов
/ 25 мая 2020

Спасибо за вашу помощь. Я хочу получить доступ к указанному приложению кинтона из VBA и отразить полученные из него данные в Excel.

«Номер ошибки 438 Объект не поддерживает это свойство или метод»

И ошибка отображается, и значение не может быть отображено. Буду признателен, если вы подскажете, как ее решить.

Option Explicit

Const DOMAIN_NAME As String = "XXXXXXXX.cybozu.com"
Const BASE_URL As String = "https://" & DOMAIN_NAME & "/k/v1/" 

Const APP_ID As String = "XXX"
Const API_TOKEN As String = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" 

Const cellFromRecNumber = "A2"
Const cellFromRecNumber2 = "B4"

Dim strURL As String 
Dim objHttpReq As Object 

Dim strJSON As String 
Dim objJSON As Object 

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:Error")
End
End If


strJSON = objHttpReq.responseText 
strJSON = Replace(strJSON, """$revision"":", """kintone_revision"":") 

Set objJSON = js.CodeObject.jsonParse(strJSON) 

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...