【VBA】Backlog APIで課題を操作する

Backlogはタスクを管理するWebアプリケーションです。
APIが提供されているので、ブラウザ上のBacklogの操作をAPIから行えます。
今回はVBAからAPIを利用して課題の登録と課題一覧の取得を行ってみます。

動作環境
事前準備
1. 参照設定
2. VBA-JSONの導入
APIキーを取得
課題の追加
1. 課題追加前の準備
2. APIを利用して課題を追加
課題一覧の取得
1. 通常取得
2. VBA-JSONでパース時にエラーが発生する場合
Backlog APIで利用できること

動作環境

Windows10 Home 64bit
Microsoft Office 365 Business
Backlog フリープラン

事前準備

参照設定

以下の3つの参照設定を利用するので、VBAエディターの参照設定でチェックを入れます。

Microsoft XML v6.0
Microsoft Scripting Runtime
Microsoft VBScript Regular Expressions 5.5

参照設定の方法は以下をご覧ください。

VBAで参照設定を行う

VBA-JSONの導入

Backlog APIでは結果がJSON形式で返ってきます。
VBAではJSONをパースする標準ライブラリがないので、VBA-JSONを利用します。

GitHub - VBA-tools/VBA-JSON: JSON conversion and parsing for VBA

JSON conversion and parsing for VBA. Contribute to VBA-tools/VBA-JSON development by creating an account on GitHub.

git cloneまたはzipファイルをダウンロードして、JsonConverter.basを
VBAのプロジェクトにインポートします。

導入方法はVBAエディターを開き、プロジェクトウィンドウでVBAProjectを
右クリックしファイルのインポートをクリックします。

VBA-JSONのJsonConverter.basを選択して「開く」をクリックします。

標準モジュールにJsonConverterが表示されれば、VBA-JSONの導入は完了です。

APIキーを取得

Backlog APIを利用するにはAPIキーを取得する必要があります。

Security check

configシートを用意し、B1セルに利用しているBacklogのURLと
B2セルに取得したAPIキーを入力しておきます。

課題の追加

課題追加前の準備

課題の追加には事前に以下の値を調べておく必要があります。

課題を登録するプロジェクトのID
- プロジェクト設定のURLのproject.idから調べる
  - https://スペース名.backlog.com/EditProject.action?project.id=xxxxx
- Backlog APIのプロジェクト情報の取得を利用する
課題の種別のID
- プロジェクト設定の種別から該当の種別を選択してURLのissueType.idから調べる
  - https://スペース名.backlog.com/EditIssueType.action?issueType.id=xxxxx&issueType.projectId=yyyyy
- Backlog APIの種別一覧の取得を利用する
課題の優先度のID
- Backlog APIの優先度一覧の取得を参照して優先度IDを調べる

APIを利用して課題を追加

事前に準備しておいた情報を利用して、BacklogAPIで課題を追加します。
テスト案件という件名で登録してみます。

Option Explicit

Private Const API_KEY_NAME As String = "apiKey"
Public Sub PostIssue()
  'BacklogAPIを利用して課題を登録する

  Dim configSht As Worksheet
  Set configSht = ThisWorkbook.Worksheets("config")
  
  Dim spaceURL As String
  Dim apiURL As String
  Dim apiKey As String

  spaceURL = configSht.Range("B1")
  apiURL = "api/v2/issues"
  apiKey = configSht.Range("B2")
  
  Dim url As String
  url = spaceURL & apiURL & "?" & API_KEY_NAME & "=" & apiKey
  
  Dim params As Dictionary
  Set params = SetParameters()
  
  Dim paramStr As String
  Dim key As Variant
  For Each key In params.Keys
    paramStr = paramStr & key & "=" & params(key) & "&"
  Next key
  paramStr = Left(paramStr, Len(paramStr) - 1)  '末尾の&は余計なので削除
  
  Dim http As New MSXML2.XMLHTTP60
  Dim responseObj As Object
  With http
    .Open "POST", url, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send paramStr
    Set responseObj = ParseJson(.responseText)
  End With
  
  Dim issueKey As String
  Dim issueType As String
  Dim summary As String
  Dim assignee As String
  issueKey = responseObj("issueKey")
  issueType = responseObj("issueType")("name")
  summary = responseObj("summary")
  assignee = responseObj("assignee")("name")

  Set configSht = Nothing
  Set http = Nothing
  Set params = Nothing
  Set responseObj = Nothing
  
  MsgBox "課題を登録しました。" & vbNewLine & vbNewLine & _
         "課題キー:" & issueKey & vbNewLine & _
         "課題種別:" & issueType & vbNewLine & _
         "件名:" & summary & vbNewLine & _
         "担当者:" & assignee & vbNewLine, vbInformation
  
End Sub

Private Function SetParameters() As Dictionary
  '課題登録のパラメータをDictionaryとして返す
  
  Dim params As New Dictionary
  
  params.Add "projectId", プロジェクトのID
  params.Add "summary", "テスト案件"
  params.Add "issueTypeId", 課題種別ID
  params.Add "priorityId", 優先度ID
  params.Add "assigneeId", 担当者のID
  
  Set SetParameters = params
  Set params = Nothing

End Function

Option Explicit

Private Const API_KEY_NAME As String = "apiKey"

Public Sub PostIssue()

'BacklogAPIを利用して課題を登録する

Dim configSht As Worksheet

Set configSht = ThisWorkbook.Worksheets("config")

Dim spaceURL As String

Dim apiURL As String

Dim apiKey As String

spaceURL = configSht.Range("B1")

apiURL = "api/v2/issues"

apiKey = configSht.Range("B2")

Dim url As String

url = spaceURL & apiURL & "?" & API_KEY_NAME & "=" & apiKey

Dim params As Dictionary

Set params = SetParameters()

Dim paramStr As String

Dim key As Variant

For Each key In params.Keys

paramStr = paramStr & key & "=" & params(key) & "&"

Next key

paramStr = Left(paramStr, Len(paramStr) - 1) '末尾の&は余計なので削除

Dim http As New MSXML2.XMLHTTP60

Dim responseObj As Object

With http

.Open "POST", url, False

.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

.send paramStr

Set responseObj = ParseJson(.responseText)

End With

Dim issueKey As String

Dim issueType As String

Dim summary As String

Dim assignee As String

issueKey = responseObj("issueKey")

issueType = responseObj("issueType")("name")

summary = responseObj("summary")

assignee = responseObj("assignee")("name")

Set configSht = Nothing

Set http = Nothing

Set params = Nothing

Set responseObj = Nothing

MsgBox "課題を登録しました。" & vbNewLine & vbNewLine & _

"課題キー:" & issueKey & vbNewLine & _

"課題種別:" & issueType & vbNewLine & _

"件名:" & summary & vbNewLine & _

"担当者:" & assignee & vbNewLine, vbInformation

End Sub

Private Function SetParameters() As Dictionary

'課題登録のパラメータをDictionaryとして返す

Dim params As New Dictionary

params.Add "projectId", プロジェクトのID

params.Add "summary", "テスト案件"

params.Add "issueTypeId", 課題種別ID

params.Add "priorityId", 優先度ID

params.Add "assigneeId", 担当者のID

Set SetParameters = params

Set params = Nothing

End Function

Private Function SetParameters() As Dictionary
  '課題登録のパラメータをDictionaryとして返す
  
  Dim params As New Dictionary
  
  params.Add "projectId", プロジェクトのID
  params.Add "summary", "テスト案件"
  params.Add "issueTypeId", 課題種別ID
  params.Add "priorityId", 優先度ID
  params.Add "assigneeId", 担当者のID
  
  Set SetParameters = params
  Set params = Nothing

End Function

Private Function SetParameters() As Dictionary

'課題登録のパラメータをDictionaryとして返す

Dim params As New Dictionary

params.Add "projectId", プロジェクトのID

params.Add "summary", "テスト案件"

params.Add "issueTypeId", 課題種別ID

params.Add "priorityId", 優先度ID

params.Add "assigneeId", 担当者のID

Set SetParameters = params

Set params = Nothing

End Function

SetParameters内でBacklogに登録に必要な情報をDictionaryに加えています。
課題の追加の内容を元に課題開始日や終了日なども設定できます。

コードを実行するとAPIの結果がJSON形式で返ってくるので
返ってきた結果をメッセージボックスに表示しています。

Backlog上でもAPIを利用して課題を登録できたことが確認できます。

課題一覧の取得

プロジェクトに課題を追加してみました。課題が2つあるので、APIを利用して課題のキーと件名を
すべて取得してみます。

issueシートを追加しておき、取得した結果をissueシートに書き込みます。

通常取得

下記のコードでAPIを利用して課題の一覧を取得しています。

Public Sub GetIssueList()

  Dim configSht As Worksheet
  Set configSht = ThisWorkbook.Worksheets("config")
  
  Dim spaceURL As String
  Dim apiURL As String
  Dim apiKey As String

  spaceURL = configSht.Range("B1")
  apiURL = "api/v2/issues"
  apiKey = configSht.Range("B2")
  
  Dim url As String
  url = spaceURL & apiURL & "?" & API_KEY_NAME & "=" & apiKey
  
  Dim params As New Dictionary
  params.Add "projectId[]", プロジェクトID
  
  Dim paramStr As String
  Dim key As Variant
  For Each key In params.Keys
    paramStr = paramStr & key & "=" & params(key) & "&"
  Next key
  paramStr = Left(paramStr, Len(paramStr) - 1)
  url = url & "&" & paramStr
  
  Dim http As New MSXML2.XMLHTTP60
  With http
    .Open "GET", url, False
    .setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
    .send
    
    Dim issueObj As Object
    Set issueObj = ParseJson(.responseText)
  End With
  
  Dim issueSht As Worksheet
  Set issueSht = ThisWorkbook.Worksheets("issue")
  issueSht.UsedRange.Clear
  
  With issueSht
    .Cells(1, 1) = ISSUE_KEY_NAME
    .Cells(1, 2) = SUMMARY_NAME
  
    Dim writeRow As Long
    writeRow = 2
    
    Dim i As Long
    For i = 1 To issueObj.Count
      .Cells(writeRow, 1) = issueObj(i)(ISSUE_KEY_NAME)
      .Cells(writeRow, 2) = issueObj(i)(SUMMARY_NAME)
      writeRow = writeRow + 1
    Next i
  End With
  
  issueSht.UsedRange.Borders.LineStyle = True
  
  Set configSht = Nothing
  Set http = Nothing
  Set issueSht = Nothing
  Set issueObj = Nothing
  
  MsgBox "課題一覧を取得しました。", vbInformation
  
End Sub

Public Sub GetIssueList()

Dim configSht As Worksheet

Set configSht = ThisWorkbook.Worksheets("config")

Dim spaceURL As String

Dim apiURL As String

Dim apiKey As String

spaceURL = configSht.Range("B1")

apiURL = "api/v2/issues"

apiKey = configSht.Range("B2")

Dim url As String

url = spaceURL & apiURL & "?" & API_KEY_NAME & "=" & apiKey

Dim params As New Dictionary

params.Add "projectId[]", プロジェクトID

Dim paramStr As String

Dim key As Variant

For Each key In params.Keys

paramStr = paramStr & key & "=" & params(key) & "&"

Next key

paramStr = Left(paramStr, Len(paramStr) - 1)

url = url & "&" & paramStr

Dim http As New MSXML2.XMLHTTP60

With http

.Open "GET", url, False

.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"

.send

Dim issueObj As Object

Set issueObj = ParseJson(.responseText)

End With

Dim issueSht As Worksheet

Set issueSht = ThisWorkbook.Worksheets("issue")

issueSht.UsedRange.Clear

With issueSht

.Cells(1, 1) = ISSUE_KEY_NAME

.Cells(1, 2) = SUMMARY_NAME

Dim writeRow As Long

writeRow = 2

Dim i As Long

For i = 1 To issueObj.Count

.Cells(writeRow, 1) = issueObj(i)(ISSUE_KEY_NAME)

.Cells(writeRow, 2) = issueObj(i)(SUMMARY_NAME)

writeRow = writeRow + 1

Next i

End With

issueSht.UsedRange.Borders.LineStyle = True

Set configSht = Nothing

Set http = Nothing

Set issueSht = Nothing

Set issueObj = Nothing

MsgBox "課題一覧を取得しました。", vbInformation

End Sub

  Dim params As New Dictionary
  params.Add "projectId[]", プロジェクトID
  
  Dim paramStr As String
  Dim key As Variant
  For Each key In params.Keys
    paramStr = paramStr & key & "=" & params(key) & "&"
  Next key
  paramStr = Left(paramStr, Len(paramStr) - 1)
  url = url & "&" & paramStr

Dim params As New Dictionary

params.Add "projectId[]", プロジェクトID

Dim paramStr As String

Dim key As Variant

For Each key In params.Keys

paramStr = paramStr & key & "=" & params(key) & "&"

Next key

paramStr = Left(paramStr, Len(paramStr) - 1)

url = url & "&" & paramStr

Dictionary型のparamsを用意して、課題一覧取得の検索条件を組み立てています。
今回はプロジェクトIDのみを検索条件に指定しました。
他の検索条件も加えたい場合は課題一覧の取得のクエリパラメータを元に
条件を加えれば、更に細かい条件で課題を取得できます。

 With http
    .Open "GET", url, False
    .setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
    .send

With http

.Open "GET", url, False

.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"

.send

URLのキャッシュがあると、前のGETの結果を利用してしまうので
下記を参考にRequestHeaderに値を入力してsendします。

Excel VBA でサーバーが動いていないのにMSXML2.XMLHTTPのレスポンスが返る？

CentOSにてPython FlaskによるWebサーバーを立ち上げ、Excel VBAよりこのサーバーに対するHTTP送受信を試みています。 VBAにて以下のコードのようにリクエストすると、一見

    Dim i As Long
    For i = 1 To issueObj.Count
      .Cells(writeRow, 1) = issueObj(i)(ISSUE_KEY_NAME)
      .Cells(writeRow, 2) = issueObj(i)(SUMMARY_NAME)
      writeRow = writeRow + 1
    Next i

Dim i As Long

For i = 1 To issueObj.Count

.Cells(writeRow, 1) = issueObj(i)(ISSUE_KEY_NAME)

.Cells(writeRow, 2) = issueObj(i)(SUMMARY_NAME)

writeRow = writeRow + 1

Next i

データの取得開始インデックスは i = 0 ではなく i = 1 から開始します。

コードを実行するとissueシートにプロジェクトの課題キーと件名の一覧が表示されます。

VBA-JSONでパース時にエラーが発生する場合

Backlogはプランによって属性を追加できます(カスタム属性)

カスタム属性を追加することによってVBA-JSONでパースできない可能性があります。
おそらく、カスタム属性の選択リストを追加するとパースできなくなると思うのですが
フリープランではカスタム属性の追加ができないので検証できていません。

VBA-JSONでパースエラーが発生する場合は下記のコードを試してみてください。

Option Explicit

Private Const API_KEY_NAME As String = "apiKey"
Private Const ISSUE_KEY_NAME As String = "issueKey"
Private Const SUMMARY_NAME As String = "summary"
Public Sub GetIssueList()

  Dim configSht As Worksheet
  Set configSht = ThisWorkbook.Worksheets("config")
  
  Dim spaceURL As String
  Dim apiURL As String
  Dim apiKey As String

  spaceURL = configSht.Range("B1")
  apiURL = "api/v2/issues"
  apiKey = configSht.Range("B2")
  
  Dim url As String
  url = spaceURL & apiURL & "?" & API_KEY_NAME & "=" & apiKey
  
  Dim params As New Dictionary
  params.Add "projectId[]", プロジェクトID
  
  Dim paramStr As String
  Dim key As Variant
  For Each key In params.Keys
    paramStr = paramStr & key & "=" & params(key) & "&"
  Next key
  paramStr = Left(paramStr, Len(paramStr) - 1)
  url = url & "&" & paramStr
  
  Dim http As New MSXML2.XMLHTTP60
  With http
    .Open "GET", url, False
    .setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
    .send
    
    Dim trimmedResponseText As String
    'JSONレスポンスボディの最初の[と最後の]を削除
    trimmedResponseText = Mid(.responseText, 2, Len(.responseText) - 2)
  End With
  
  Dim jsonResponses As Variant
  Set jsonResponses = SplitJsonIssueListResult(trimmedResponseText)
  
  Dim aryCount As Long
  aryCount = jsonResponses.Count - 1
  
  Dim responseDic() As Dictionary
  ReDim responseDic(aryCount)
  Dim i As Long
  For i = 0 To aryCount
    Dim issueObj As Object
    Set issueObj = ParseJson(jsonResponses(i))
    Set responseDic(i) = issueObj
  Next i
  
  Dim issueSht As Worksheet
  Set issueSht = ThisWorkbook.Worksheets("issue")
  issueSht.UsedRange.Clear
  
  With issueSht
    .Cells(1, 1) = ISSUE_KEY_NAME
    .Cells(1, 2) = SUMMARY_NAME
  
    Dim writeRow As Long
    writeRow = 2
    
    For i = 0 To aryCount
      .Cells(writeRow, 1) = responseDic(i)(ISSUE_KEY_NAME)
      .Cells(writeRow, 2) = responseDic(i)(SUMMARY_NAME)
      writeRow = writeRow + 1
    Next i
  End With
  
  issueSht.UsedRange.Borders.LineStyle = True
  
  Set configSht = Nothing
  Set http = Nothing
  Set issueSht = Nothing
  Set issueObj = Nothing
  
  MsgBox "課題一覧を取得しました。", vbInformation
  
End Sub

Private Function SplitJsonIssueListResult(json_result As String) As Variant
  '課題一覧のJSONレスポンスを課題ごとに分割して配列で返す
  
  Dim re As New RegExp
  re.Pattern = "{.*?""stars"":\[.*?\]}"
  re.Global = True
  
  Set SplitJsonIssueListResult = re.Execute(json_result)
  Set re = Nothing

End Function

Option Explicit

Private Const API_KEY_NAME As String = "apiKey"

Private Const ISSUE_KEY_NAME As String = "issueKey"

Private Const SUMMARY_NAME As String = "summary"

Public Sub GetIssueList()

Dim configSht As Worksheet

Set configSht = ThisWorkbook.Worksheets("config")

Dim spaceURL As String

Dim apiURL As String

Dim apiKey As String

spaceURL = configSht.Range("B1")

apiURL = "api/v2/issues"

apiKey = configSht.Range("B2")

Dim url As String

url = spaceURL & apiURL & "?" & API_KEY_NAME & "=" & apiKey

Dim params As New Dictionary

params.Add "projectId[]", プロジェクトID

Dim paramStr As String

Dim key As Variant

For Each key In params.Keys

paramStr = paramStr & key & "=" & params(key) & "&"

Next key

paramStr = Left(paramStr, Len(paramStr) - 1)

url = url & "&" & paramStr

Dim http As New MSXML2.XMLHTTP60

With http

.Open "GET", url, False

.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"

.send

Dim trimmedResponseText As String

'JSONレスポンスボディの最初の[と最後の]を削除

trimmedResponseText = Mid(.responseText, 2, Len(.responseText) - 2)

End With

Dim jsonResponses As Variant

Set jsonResponses = SplitJsonIssueListResult(trimmedResponseText)

Dim aryCount As Long

aryCount = jsonResponses.Count - 1

Dim responseDic() As Dictionary

ReDim responseDic(aryCount)

Dim i As Long

For i = 0 To aryCount

Dim issueObj As Object

Set issueObj = ParseJson(jsonResponses(i))

Set responseDic(i) = issueObj

Next i

Dim issueSht As Worksheet

Set issueSht = ThisWorkbook.Worksheets("issue")

issueSht.UsedRange.Clear

With issueSht

.Cells(1, 1) = ISSUE_KEY_NAME

.Cells(1, 2) = SUMMARY_NAME

Dim writeRow As Long

writeRow = 2

For i = 0 To aryCount

.Cells(writeRow, 1) = responseDic(i)(ISSUE_KEY_NAME)

.Cells(writeRow, 2) = responseDic(i)(SUMMARY_NAME)

writeRow = writeRow + 1

Next i

End With

issueSht.UsedRange.Borders.LineStyle = True

Set configSht = Nothing

Set http = Nothing

Set issueSht = Nothing

Set issueObj = Nothing

MsgBox "課題一覧を取得しました。", vbInformation

End Sub

Private Function SplitJsonIssueListResult(json_result As String) As Variant

'課題一覧のJSONレスポンスを課題ごとに分割して配列で返す

Dim re As New RegExp

re.Pattern = "{.*?""stars"":\[.*?\]}"

re.Global = True

Set SplitJsonIssueListResult = re.Execute(json_result)

Set re = Nothing

End Function

  Dim params As New Dictionary
  params.Add "projectId[]", プロジェクトID
  
  Dim paramStr As String
  Dim key As Variant
  For Each key In params.Keys
    paramStr = paramStr & key & "=" & params(key) & "&"
  Next key
  paramStr = Left(paramStr, Len(paramStr) - 1)
  url = url & "&" & paramStr

Dim params As New Dictionary

params.Add "projectId[]", プロジェクトID

Dim paramStr As String

Dim key As Variant

For Each key In params.Keys

paramStr = paramStr & key & "=" & params(key) & "&"

Next key

paramStr = Left(paramStr, Len(paramStr) - 1)

url = url & "&" & paramStr

Dictionary型のparamsを用意して、課題一覧取得の検索条件を組み立てています。
今回はプロジェクトIDのみを検索条件に指定しました。
他の検索条件も加えたい場合は課題一覧の取得を参照してください。

  With http
    .Open "GET", url, False
    .setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
    .send

With http

.Open "GET", url, False

.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"

.send

URLのキャッシュがあると、前のGETの結果を利用してしまうので
下記を参考にRequestHeaderに値を入力してsendします。

Excel VBA でサーバーが動いていないのにMSXML2.XMLHTTPのレスポンスが返る？

    Dim trimmedResponseText As String
    'JSONレスポンスボディの最初の[と最後の]を削除
    trimmedResponseText = Mid(.responseText, 2, Len(.responseText) - 2)

Dim trimmedResponseText As String

'JSONレスポンスボディの最初の[と最後の]を削除

trimmedResponseText = Mid(.responseText, 2, Len(.responseText) - 2)

取得したデータの括弧を削除しておきます。

  Set jsonResponses = SplitJsonIssueListResult(trimmedResponseText)

1	Set jsonResponses = SplitJsonIssueListResult(trimmedResponseText)

SplitJsonIssueListResult内で正規表現を使用して、結果をすべて取得できるようにします。

コードを実行するとissueシートにプロジェクトの課題キーと件名の一覧が表示されます。

Backlog APIで利用できること

Excelなどに課題テンプレートを用意しておきAPIを利用して課題テンプレートを登録
登録時に返ってきたBacklogの登録IDを利用して親子課題の設定
- 今回はフリープランを利用しているので親子課題は設定できませんでしたが・・
課題の編集

Backlog APIで色々できるので詳しくはBacklog APIを参照してください。

Backlog API とは | Backlog Developer API | Nulab

開発者コミュニティで公開しているAPIを使って、プロジェクト管理ツール Backlog と連携

田中　格より:

2020/06/23(火) 9:15 AM

下記の操作は不要だと思います。

‘課題一覧のJSONレスポンスを課題ごとに分割して配列で返す

また正規表現で区切りを見つける方法は不具合が生じます。
最後のキーワードが必ず指定したキーワードになるという保証がないためです。

結果的に普通にSet responseObj = ParseJson(.responseText)で配列についてはresponseObj(1)(“id”)という表現で取得できます。（但し1オリジンです。理由は配列でなくコレクションを利用しているためです。そして配列の数はresponseObj.countで取得できます）

返信
- かずさプログラマーより:
  
  2020/07/12(日) 10:51 AM
  
  田中さん
  
  コメントありがとうございます。
  記事を修正しました。
  
  返信