Chatwork - メッセージの送信

ソースコード

' 送信先URI
Private Const END_POINT As String = "https://api.chatwork.com/v2/"

' 使用するAPIトークン
Private Const API_TOKEN As String = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"

Public Function Api( _
        ByRef method As String, _
        ByRef url As String, _
        ByRef 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", API_TOKEN)
        Call .send(param)

        Api = .responseText
    End With
End Function

Public Function SendMessage(ByRef roomId As String, ByRef message As String) As String

    Dim url As String, param As String
    url = "rooms/" & roomId & "/messages"

    param = "body=" & message

    SendMessage = Api("POST", url, param)
End Function

解説

API_TOKEN の部分に利用するユーザの API トークンを貼り付けてください。API トークン(使用ユーザ)も動的にしたい場合は、モジュールではなくクラスを作成するか、定数から引数に移動させてください。

後は、上記のファンクションを以下のように呼び出すだけで取得できます。

Call SendMessage("00000", "このメッセージはExcelから送信されました")

“00000”の部分が送信先のグループチャットになります。グループチャットの取得については、以下の記事を参考にしてください。今回使った Api ファンクションを使えば、2 行足すだけで実装することができます。

送信後に取得できる HTTP ヘッダー情報などは、以下を参考にしてください。

Chatwork API ドキュメント - エンドポイント: /contacts

グループチャット名からメッセージを送信する

もしこの VBA プログラムを Excel 利用者向けに使用する場合、メッセージの送信のために、ルーム ID を指定しないといけないのは不親切です。

予めコンタクト一覧をリスト化しておくのもいいですが、リアルタイムに取得する場合のため、グループチャット名を指定してメッセージを送信できるファンクションもご紹介しておきます。

※上述した、コンタクト一覧を取得する記事内で紹介しているファンクション及び、JsonConverter を使うことを前提としています

Public Sub SendFromName(ByRef name As String, ByRef message As String)

    Dim records As Object
    Set records = JsonConverter.ParseJson(GetContacts)
    Dim record As Object
    For Each record In records
        If name = record("name") Then
            Call SendMessage(record("room_id"), message)
            Exit For
        End If
    Next
End Sub