VBA で kintone レコードを取得し json 変換

VBA で kintone からレコード取得し json 変換する例です。
json 変換に、cJobject ライブラリを使用します。
だいぶ期間が空きましたが、前回　[VBA で JSON 変換する cJobject ライブラリ](http://qiita.com/rex0220/items/b29b8e260a9b5c96432f)の続きです。

# 環境

Windows 10 Pro
Excel 2016

# cjobject ライブラリの準備

cJobject の機能を使うには、下記からexcel ファイルをダウンロードします。
[ダウンロードページ](http://ramblings.mcpher.com/Home/excelquirks/downlable-items) で、Data Manipulation　を展開すると、最後にvanillacJobject.xlsm があります。


今回は、ダウンロードしたファイルに、VBA IDE で、Module を追加して処理を記述します。


# kintone REST API レコード取得

レコード取得方法は、[第2回 Excelとkintoneを連携させよう](https://developer.cybozu.io/hc/ja/articles/201932564-%E7%AC%AC2%E5%9B%9E-Excel%E3%81%A8kintone%E3%82%92%E9%80%A3%E6%90%BA%E3%81%95%E3%81%9B%E3%82%88%E3%81%86)　とほとんど同じです。

ただし、例とXMLHTTP オブジェクトのバージョンが違っていたので、変更しました。

```
 Dim objHttpReq As XMLHTTP60   ' XMLHTTP オブジェクト
```

# ログイン認証のBase64変換

cJobject ライブラリに、Base64Encode関数があるので、それを使います。

```.vba
Dim strAuthorization As String     ' Authorization
strAuthorization = Base64Encode("USER:PASS")
```

# レスポンス情報を json 変換

JSONParse 関数でレスポンス情報を、cjobject に変換できます。

```.vba
    Dim resp As cJobject           ' json data
    Dim records As cJobject           ' json data
    ...
    Set resp = JSONParse(strJSON)
    Set records = resp.child("records")

```

# レコード内の項目値を取り出す

レコードからユーザー選択項目を取り出します。

```.vba
    Dim strTemp As String
    
    For Each record In records.children
        Dim users As cJobject
        Dim user As cJobject
        Set users = record.child("ユーザー選択").child("value")
        strTemp = ""
        If users.children.Count > 0 Then
            
            ' ユーザーの１番目
            Debug.Print "ユーザー選択(1) " & users.child(1).child("name").value
            
            ' 全ユーザー
            For Each user In users.children
                If strTemp <> "" Then
                    strTemp = strTemp & ", "
                End If
                strTemp = strTemp & user.child("code").value & ":" & user.child("name").value
            Next user
            Debug.Print "ユーザー選択: " & strTemp
        End If
    Next record
```

# Access shortcut

cJobject では、下記の JavaScript のような、書き方で、項目の値を取得できます。

```JavaScript.js
    Console.log("Access shortcut: ", records[0]["ユーザー選択"].value[0].code;
```

cJobject の Access shortcut 機能

```cJobject.vba
    Debug.Print "Access shortcut: " & records.child("1.ユーザー選択.value.1.code").value
```

# VBA コード全体

```module1.vba
Sub kintoneGetTest1()
    
    '--------------------------------------------------------------------
    '  変数定義
    '--------------------------------------------------------------------
    Dim objHttpReq As XMLHTTP60   ' XMLHTTP オブジェクト
    Dim strJSON As String              ' レスポンスで受け取るJSONデータ
    Dim strURL As String               ' アクセス先URL
    Dim strQuery As String             ' 検索文字列
    Dim strAuthorization As String     ' Authorization
    
    strAuthorization = Base64Encode("USER:PASS")
    
    '------------------------------------------------------------------
    ' 検索文字付きURLを作成する
    '------------------------------------------------------------------
    strQuery = "ユーザー選択 in ( ""Alex2013"" )"
    strQuery = URL_Encode(strQuery)
    
    strURL = "https://<サブドメイン>.cybozu.com/k/v1/records.json?&app=846&query=" & strQuery
    
    '------------------------------------------------------------------
    ' XMLHTTP オブジェクトを生成する
    '------------------------------------------------------------------
    Set objHttpReq = CreateObject("MSXML2.XMLHTTP")
    objHttpReq.Open "GET", strURL, False
    '------------------------------------------------------------------
    ' XMLHTTP のリクエストヘッダーを指定する
    '------------------------------------------------------------------
    ' ログイン認証
    objHttpReq.setRequestHeader "X-Cybozu-Authorization", strAuthorization
    ' Basic 認証
    'objHttpReq.setRequestHeader "Authorization", "Basic " & <ベーシック認証情報>
    'ドメイン名：ポート番号
    objHttpReq.setRequestHeader "Host", "<サブドメイン>.cybozu.com" + ":443"
    'キャッシュ対策（常にレスポンスが取得できる状態にする）
    objHttpReq.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
    
    '------------------------------------------------------------------
    ' リクエストを送信する
    '------------------------------------------------------------------
    objHttpReq.send (Null)
    
    '------------------------------------------------------------------
    ' レスポンスを取得する
    '------------------------------------------------------------------
    'レスポンス情報を変数に格納する
    
    Dim resp As cJobject           ' json data
    Dim records As cJobject           ' json data
    Dim record As cJobject           ' json data
    
    strJSON = objHttpReq.responseText
    'Debug.Print "resp: " & strJSON
    Set resp = JSONParse(strJSON)
    Set records = resp.child("records")
    
    Dim strTemp As String
    
    For Each record In records.children
        Dim users As cJobject
        Dim user As cJobject
        Set users = record.child("ユーザー選択").child("value")
        strTemp = ""
        If users.children.Count > 0 Then
            
            ' ユーザーの１番目
            Debug.Print "ユーザー選択(1) " & users.child(1).child("name").value
            
            ' 全ユーザー
            For Each user In users.children
                If strTemp <> "" Then
                    strTemp = strTemp & ", "
                End If
                strTemp = strTemp & user.child("code").value & ":" & user.child("name").value
            Next user
            Debug.Print "ユーザー選択: " & strTemp
        End If
    Next record

    Debug.Print
    Debug.Print "Access shortcut: " & records.child("1.ユーザー選択.value.1.code").value

End Sub


'--------------------------------------
'URLエンコード用関数
'--------------------------------------
Function URL_Encode(ByVal strOrg As String) As String
  Dim d As Object
  Dim elm As Object
  
  strOrg = Replace(strOrg, "\", "\\")
  strOrg = Replace(strOrg, "'", "\'")
  Set d = CreateObject("htmlfile")
  Set elm = d.createElement("span")
  elm.setAttribute "id", "result"
  d.appendChild elm
  d.parentWindow.execScript "document.getElementById('result').innerText = encodeURIComponent('" & strOrg & "');", "JScript"
  URL_Encode = elm.innerText
End Function

```

# 実行結果

イミディエイトウィンドウ

```
ユーザー選択(1) Alex2013
ユーザー選択: Alex2013:Alex2013, Alex2014:Alex2014

Access shortcut: Alex2013
```

# 関連

[VBA で kintone レコードを取得し json 変換](http://qiita.com/rex0220/items/a3fd335e4d8e87e02af7)
[VBA で kintone ユーザー情報を取得し json 変換](http://qiita.com/rex0220/items/4cff6401f89f6f3c9def)
[VBA で kintone 新規レコード作成、json 文字列変換](http://qiita.com/rex0220/items/a196a0b7121217b7495c)