OutlookVBAでRedmineへRestAPI経由でチケット登録する例

Exchange環境でメールからRedmineへチケット自動追加をしたいと思ったが、なかなか既存の情報からはうまくいかず、OutlookVBAで直接RedmineのRestAPIをたたいてチケット追加を試してみた。

まずは、RedmineでRestAPIを有効化する。
「管理」→「設定」と進み、「RESTによるWebサービスを有効にする」をチェック

そのあと、個人設定へ移り右側のAPIアクセスキーの「表示」リンクを押して、キーを取得しておく。

Outlookで書いたVBAマクロは以下の通り

CustomRuleMakeTicket.vb

Option Explicit

Const REDMINE_API_KEY = "<上記で取得したAPIキー>"
Const REDMINE_URL = "http://localhost/redmine" '対象RedmineへのURL

Const PROJECT_ID = 1

Public Sub CustomRule_MakeTicket(Item As Outlook.MailItem)
    Dim ReqStatus

    ReqStatus = PostIssue(Item.Subject, Item.Body)

    If ReqStatus <> False Then
        MsgBox "登録成功"
    Else
        MsgBox "登録失敗"
    End If
End Sub

' PostIssue - Redmineにチケットを登録する
'
' [引数]
' Subject:  チケットの題名
' Body:     チケットの内容
'
' [戻り値]
' True:  成功
' False: 失敗
'
Function PostIssue(Subject As String, Body As String)
    Dim xhr
    Dim RequestURL As String
    Dim RequestBody As String
    Dim bPmary() As Byte

    RequestURL = REDMINE_URL & "/issues.xml?format=xml&key=" &
REDMINE_API_KEY

    Set xhr = CreateObject("Microsoft.XMLHTTP")
    xhr.Open "POST", RequestURL, False
    xhr.SetRequestHeader "Content-Type", "text/xml"

    RequestBody = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>"
    RequestBody = RequestBody & "<issue>"
    RequestBody = RequestBody & "<project_id>" & PROJECT_ID & "</project_id>"
    RequestBody = RequestBody & "<subject>" & Subject & "</subject>"
    RequestBody = RequestBody & "<description>" & Body & "</description>"
    RequestBody = RequestBody & "</issue>"

    xhr.Send (RequestBody)

    If xhr.Status = 201 Then
        PostIssue = True
    Else
        PostIssue = False
    End If

End Function

上記のマクロを登録しておき、Outlookの振り分けルールでスクリプトを実行するアクションを定義し、上記のマクロを指定すれば自動でチケット登録ができるはず