RedmineのREST API (PUT)でチケットを更新するExcel VBAのサンプル

概要

既存のRedmineチケットをREST API (PUT)経由で更新するExcelマクロ(VBA)のサンプル。

コード

Option Explicit

Public Const REDMINE_URL As String = "http://myserver/redmine/"

Public Sub Test1()

    Dim requestStatus As String
    requestStatus = UpdateIssue( _
        1, _
        "94811293a201319fbaea04af5c0fd8a52b06c65f", _
        "説明の更新テスト", _
        "注記の追加テスト")
    MsgBox requestStatus

End Sub

Public Function UpdateIssue( _
    ByVal issueId As Integer, _
    ByVal apiKey As String, _
    ByVal description As String, _
    ByVal notes As String) As String

    Dim sendBody As Variant
    sendBody = "<?xml version=""1.0""?><issue>"
    If Len(Trim(description)) > 0 Then
        sendBody = sendBody & "<description>" & description & "</description>"
    End If
    If Len(Trim(notes)) > 0 Then
        sendBody = sendBody & "<notes>" & notes & "</notes>"
    End If
    sendBody = sendBody & "</issue>"

    Dim xmlHttp As New MSXML2.XMLHTTP60
    With xmlHttp
        .Open "PUT", REDMINE_URL & "issues/" & CStr(issueId) & ".xml?key=" & apiKey, False
        .SetRequestHeader "Content-Type", "text/xml"
        .Send sendBody
        UpdateIssue = CStr(.Status)
    End With
    Set xmlHttp = Nothing

End Function

補足

• 参照設定で「Microsoft XML, v6.0」を選択する必要がある。
  

• このサンプルでは説明(description)の更新と注記(notes)の追加を試したが、それ以外のParametersも指定できるはず。
  参考 http://www.redmine.org/projects/redmine/wiki/Rest_Issues#Updating-an-issue