###KINTONEのデータをVBAで取得しエクセルで使用しようとするとエラーになる
KINTONEのデータをVBAで取得しエクセルで使用しようとしています。
クエリ部分でエラーになり、「入力内容が正しくありません。」とエラーになります。
コメントアウトしてある
Param = “app=” & AppId & “&query=limit 500”
では問題なく取得できました。
Param = “app=” & AppId & "&query=報告日 = ““2024-05-24"””
の際のリクエストURLは
https://xxxxx.cybozu.com/k/v1/records.json?app=214&query=報告日 = “2024-05-24”
となっています。
初歩的な質問で恐縮ですが、間違いをご教示いただければと思います。。。
実行したコードをコピー＆ペーストしましょう
' サブドメインを保持
Dim SubDomain As String
' アプリIDを保持
Dim AppId As String
' APIトークンを保持
Dim ApiToken As String
Private Function KickWebService(ByVal Path As String, _
ByVal Param As String) As String
Dim Url As String
Url = "https://" & SubDomain & ".cybozu.com/k/v1/" & Path & "?" & Param
' リクエストを送信する
Debug.Print Url
Dim http As Object
Set http = CreateObject("MSXML2.XMLHTTP")
With http
' GETで送信する
.Open "GET", Url, False
' リクエストヘッダにAPIトークンを含める
.setRequestHeader "X-Cybozu-API-Token", ApiToken
.send
KickWebService = .responseText
End With
End Function
Private Sub allDataGetCommandButton_Click()
Dim DataWorksheet As Worksheet
Set DataWorksheet = Worksheets("固定データ")
SubDomain = DataWorksheet.Range("C4").Value
AppId = DataWorksheet.Range("C5").Value
ApiToken = DataWorksheet.Range("C6").Value
Dim Row As Integer, Col As Integer
Row = 10
Col = 1
Dim TargetMonth As String
Dim Param As String
' Param = "app=" & AppId & "&query=limit 500"
Param = "app=" & AppId & "&query=報告日 = ""2024-05-24"""
Dim Result As String
Result = KickWebService("records.json", Param)
If Left(Result, 1) <> "[" And Left(Result, 1) <> "{" Then
Cells(Row, Col) = "取得できませんでした"
Exit Sub
End If
Dim Json As Object
Set Json = JsonConverter.ParseJson(Result)
If Not Json.Exists("records") Then
Cells(Row, Col) = Json("message")
Exit Sub
End If
Dim Items As Variant, ItemCount As Integer
Set Items = Json("records")
ItemCount = Items.Count
Dim Keys As Variant
Keys = ActiveSheet.Range("A9:G9").Value
Dim ColumnCount As Integer
ColumnCount = UBound(Keys, 2)
Dim ItemList As Variant
ReDim ItemList(1 To ItemCount, 1 To ColumnCount)
Dim Count As Integer
For Count = 1 To ItemCount
Dim Item As Object
Set Item = Items(Count)
' 各列について処理する
Dim Index As Integer
For Index = 1 To ColumnCount
Dim Key As String, Value As Variant
Key = Keys(1, Index)
' 列名がキーに存在すればデータを取得する
If Item.Exists(Key) Then
Set Value = Item(Key)
ItemList(Count, Index) = Value("value")
Else
ItemList(Count, Index) = "データなし"
End If
Next Index
Next Count
' 配列をセルに書き込む
Range(Cells(Row, Col), _
Cells(Row + ItemCount - 1, Col + ColumnCount - 1)).Value = ItemList
With Range(Cells(Row, Col), Cells(Row + ItemCount - 1, Col + ColumnCount - 1)).Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub
