ExcelからPleasanterへアクセスしたい

Private Sub SampleCode()

''' 環境ごとに設定が必要な値
' -------- 1
' https://demo.pleasanter.org/users/editapi の API キー欄の値をコピーします。空白の場合 "作成" ボタンを押して生成します。
Const APIKEY As String = " ここに API キーを文字列として記入します "
' -------- 2
' デモサイトにて「商談管理の例」>「商談」を開き、その URL の以下の数値を 0 に置き替えます。
' https://demo.pleasanter.org/items/_ここにある数値_/index
Const SiteID As Long = 0
' -------- 3
' シート名を指定します。ここでは仮に　Sheet1 としています。
Dim SheetName As String
SheetName = "Sheet1"
'''

Dim jsonRequest As Dictionary
Dim parseResponse As Dictionary
Dim httpRequest As Object
Dim i As Integer
Dim j As Integer
Dim Sheet As Worksheet
Set Sheet = Worksheets(SheetName)
Dim Hashs As Dictionary

'---------------------------------
'　1. リクエストパラメータを生成
'    リクエストパラメータとして利用するデータを Dictionary オブジェクトとして作成します。
'---------------------------------
Set jsonRequest = New Dictionary
jsonRequest.Add "ApiVersion", "1.1"
jsonRequest.Add "ApiKey", APIKEY
jsonRequest.Add "View", New Dictionary
jsonRequest("View").Add "ColumnFilterHash", New Dictionary
' "状況"でフィルタします。ここでは"引き合い"と"提案"に対応するコード値を指定しています。
jsonRequest("View")("ColumnFilterHash").Add "Status", "[""100"",""150""]"

Set httpRequest = CreateObject("MSXML2.XMLHTTP")
httpRequest.Open "POST", "https://demo.pleasanter.org/api/items/" & SiteID & "/get", False
httpRequest.setRequestHeader "Content-Type", "application/json;charset=utf-8"

'---------------------------------
'　2. リクエストを発行
'    Dictionary を JSON 形式に変換してリクエストを実施します。
'---------------------------------
httpRequest.send JsonConverter.ConvertToJson(jsonRequest)

'---------------------------------
'　3. レスポンスをシートに転記
'    API の応答結果である JSON を辞書から読み出してシートに転記します。
'---------------------------------
Set parseResponse = JsonConverter.ParseJson(httpRequest.responseText)
Set Records = parseResponse("Response")("Data")

' 取得件数が 0 件のときは中断
If Records.Count <= 0 Then
    Exit Sub
End If

' シートに転記
Sheet.Cells.Clear
i = 2
For Each Record In Records
    j = 1
    With Sheet
        For Each ColumnName In Record.Keys()
            If ColumnName = "ApiVersion" Or ColumnName = "Comments" Or ColumnName = "AttachmentsHash" Then
                GoTo ContinueTarget:
            ElseIf Right(ColumnName, 4) = "Hash" Then
                For Each HashColumn In Record(ColumnName).Keys()
                    Set Hashs = Record(ColumnName)
                    .Cells(1, j).Value = HashColumn
                    .Cells(i, j).Value = Hashs(HashColumn)
                    j = j + 1
                Next
            Else
                .Cells(1, j).Value = ColumnName
                .Cells(i, j).Value = Record(ColumnName)
                j = j + 1
            End If
ContinueTarget:
         Next
     End With
     i = i + 1
Next

End Sub