Chatwork - ユーザー一覧の取得
にメンテナンス済み
ソースコード
' 送信先URI
Private Const END_POINT As String = "https://api.chatwork.com/v2/"
Private Function GetChatworkApiToken() As String
GetChatworkApiToken = Environ$("CHATWORK_API_TOKEN")
If Len(GetChatworkApiToken) = 0 Then
Err.Raise vbObjectError + 1000, , "環境変数 CHATWORK_API_TOKEN が設定されていません。"
End If
End Function
Public Function Api(ByVal method As String, ByVal url As String, Optional ByVal param As String = "") As String
Dim httpRequest As Object
Set httpRequest = CreateObject("MSXML2.XMLHTTP")
With httpRequest
Call .Open(method, END_POINT & url, False)
If method = "POST" Or method = "PUT" Then
Call .setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
End If
Call .setRequestHeader("X-ChatWorkToken", GetChatworkApiToken())
Call .send(param)
If .Status < 200 Or .Status >= 300 Then
Err.Raise vbObjectError + 1001, , "Chatwork API Error: " & .Status & " - " & .responseText
End If
Api = .responseText
End With
End Function
API トークンは Chatwork のサービス連携画面で発行し、環境変数 CHATWORK_API_TOKEN に設定してから実行します。ソースコードへ直接貼り付けると、ファイル共有や Git 管理を通じて漏えいする可能性があります。
後は、上記のファンクションを以下のように呼び出すだけで取得できます。
Dim contacts As String
contacts = Api("GET", "contacts", "")
呼び出しを更に簡易化させたい場合は、もう一つファンクションをかませましょう。
Public Function GetContacts() As String
GetContacts = Api("GET", "contacts", "")
End Function
レスポンスの整形
取得は完了しましたが、取得されるデータは String 形式の json ファイルです。Excel は XML のパースはできますが、json とは相性が悪いので、受け取ったファイルを自力で解析しないといけません。オススメの対処法は、GitHub に公開されている、JSON Converter を使う方法がいいかと思います。
上記のサイトから.bas ファイルをダウンロードし、VBE からインポートしましょう。後はモジュールを利用し、データをイテレータで取得するだけです。
Dim records As Object, record As Object
Set records = JsonConverter.ParseJson(response)
For Each record In records
record("account_id") ' → 対象アカウントID
record("room_id") ' → 対象アカウントとのルームID
record("name") ' → 対象アカウントの表示名
record("avatar_image_url") ' → 対象アカウントのアイコン
Next
よく使うパラメータは上記ぐらいでしょうか。他に取得されるパラメータが知りたい方は、Chatwork が公開しているドキュメントを参照してください。
Chatwork API ドキュメント - コンタクト一覧を取得する
#VBA