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

2019年12月30日 · 8 分で読了 · Backlog ExcelVBA

概要

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

動作環境

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

事前準備

参照設定

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

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

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

https://kazusa-pg.com/vba-references/

VBA-JSONの導入

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

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

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

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

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

APIキーを取得

Backlog APIを利用するにはAPIキーを取得する必要があります。
https://support-ja.backlog.com/hc/ja/articles/360035641754-API%E3%81%AE%E8%A8%AD%E5%AE%9A

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で課題を追加します。
テスト案件という件名で登録してみます。

 1Option Explicit
 2
 3Private Const API_KEY_NAME As String = "apiKey"
 4Public Sub PostIssue()
 5  'BacklogAPIを利用して課題を登録する
 6
 7  Dim configSht As Worksheet
 8  Set configSht = ThisWorkbook.Worksheets("config")
 9  
10  Dim spaceURL As String
11  Dim apiURL As String
12  Dim apiKey As String
13
14  spaceURL = configSht.Range("B1")
15  apiURL = "api/v2/issues"
16  apiKey = configSht.Range("B2")
17  
18  Dim url As String
19  url = spaceURL & apiURL & "?" & API_KEY_NAME & "=" & apiKey
20  
21  Dim params As Dictionary
22  Set params = SetParameters()
23  
24  Dim paramStr As String
25  Dim key As Variant
26  For Each key In params.Keys
27    paramStr = paramStr & key & "=" & params(key) & "&"
28  Next key
29  paramStr = Left(paramStr, Len(paramStr) - 1)  '末尾の&は余計なので削除
30  
31  Dim http As New MSXML2.XMLHTTP60
32  Dim responseObj As Object
33  With http
34    .Open "POST", url, False
35    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
36    .send paramStr
37    Set responseObj = ParseJson(.responseText)
38  End With
39  
40  Dim issueKey As String
41  Dim issueType As String
42  Dim summary As String
43  Dim assignee As String
44  issueKey = responseObj("issueKey")
45  issueType = responseObj("issueType")("name")
46  summary = responseObj("summary")
47  assignee = responseObj("assignee")("name")
48
49  Set configSht = Nothing
50  Set http = Nothing
51  Set params = Nothing
52  Set responseObj = Nothing
53  
54  MsgBox "課題を登録しました。" & vbNewLine & vbNewLine & _
55"課題キー:" & issueKey & vbNewLine &_
56         "課題種別:" & issueType & vbNewLine & _
57"件名:" & summary & vbNewLine &_
58         "担当者:" & assignee & vbNewLine, vbInformation
59  
60End Sub
61
62Private Function SetParameters() As Dictionary
63  '課題登録のパラメータをDictionaryとして返す
64  
65  Dim params As New Dictionary
66  
67  params.Add "projectId", プロジェクトのID
68  params.Add "summary", "テスト案件"
69  params.Add "issueTypeId", 課題種別ID
70  params.Add "priorityId", 優先度ID
71  params.Add "assigneeId", 担当者のID
72  
73  Set SetParameters = params
74  Set params = Nothing
75
76End Function

 1Private Function SetParameters() As Dictionary
 2  '課題登録のパラメータをDictionaryとして返す
 3  
 4  Dim params As New Dictionary
 5  
 6  params.Add "projectId", プロジェクトのID
 7  params.Add "summary", "テスト案件"
 8  params.Add "issueTypeId", 課題種別ID
 9  params.Add "priorityId", 優先度ID
10  params.Add "assigneeId", 担当者のID
11  
12  Set SetParameters = params
13  Set params = Nothing
14
15End Function

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

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

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

課題一覧の取得

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

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

通常取得

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

 1Public Sub GetIssueList()
 2
 3  Dim configSht As Worksheet
 4  Set configSht = ThisWorkbook.Worksheets("config")
 5  
 6  Dim spaceURL As String
 7  Dim apiURL As String
 8  Dim apiKey As String
 9
10  spaceURL = configSht.Range("B1")
11  apiURL = "api/v2/issues"
12  apiKey = configSht.Range("B2")
13  
14  Dim url As String
15  url = spaceURL & apiURL & "?" & API_KEY_NAME & "=" & apiKey
16  
17  Dim params As New Dictionary
18  params.Add "projectId[]", プロジェクトID
19  
20  Dim paramStr As String
21  Dim key As Variant
22  For Each key In params.Keys
23    paramStr = paramStr & key & "=" & params(key) & "&"
24  Next key
25  paramStr = Left(paramStr, Len(paramStr) - 1)
26  url = url & "&" & paramStr
27  
28  Dim http As New MSXML2.XMLHTTP60
29  With http
30    .Open "GET", url, False
31    .setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
32    .send
33
34    Dim issueObj As Object
35    Set issueObj = ParseJson(.responseText)
36  End With
37  
38  Dim issueSht As Worksheet
39  Set issueSht = ThisWorkbook.Worksheets("issue")
40  issueSht.UsedRange.Clear
41  
42  With issueSht
43    .Cells(1, 1) = ISSUE_KEY_NAME
44    .Cells(1, 2) = SUMMARY_NAME
45  
46    Dim writeRow As Long
47    writeRow = 2
48
49    Dim i As Long
50    For i = 1 To issueObj.Count
51      .Cells(writeRow, 1) = issueObj(i)(ISSUE_KEY_NAME)
52      .Cells(writeRow, 2) = issueObj(i)(SUMMARY_NAME)
53      writeRow = writeRow + 1
54    Next i
55  End With
56  
57  issueSht.UsedRange.Borders.LineStyle = True
58  
59  Set configSht = Nothing
60  Set http = Nothing
61  Set issueSht = Nothing
62  Set issueObj = Nothing
63  
64  MsgBox "課題一覧を取得しました。", vbInformation
65  
66End Sub

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

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

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

URLのキャッシュがあると前のGETの結果を利用してしまうので下記を参考にRequestHeaderに値を入力してsendします。
https://teratail.com/questions/156267

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

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

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

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

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

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

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

 1Option Explicit
 2
 3Private Const API_KEY_NAME As String = "apiKey"
 4Private Const ISSUE_KEY_NAME As String = "issueKey"
 5Private Const SUMMARY_NAME As String = "summary"
 6Public Sub GetIssueList()
 7
 8  Dim configSht As Worksheet
 9  Set configSht = ThisWorkbook.Worksheets("config")
10  
11  Dim spaceURL As String
12  Dim apiURL As String
13  Dim apiKey As String
14
15  spaceURL = configSht.Range("B1")
16  apiURL = "api/v2/issues"
17  apiKey = configSht.Range("B2")
18  
19  Dim url As String
20  url = spaceURL & apiURL & "?" & API_KEY_NAME & "=" & apiKey
21  
22  Dim params As New Dictionary
23  params.Add "projectId[]", プロジェクトID
24  
25  Dim paramStr As String
26  Dim key As Variant
27  For Each key In params.Keys
28    paramStr = paramStr & key & "=" & params(key) & "&"
29  Next key
30  paramStr = Left(paramStr, Len(paramStr) - 1)
31  url = url & "&" & paramStr
32  
33  Dim http As New MSXML2.XMLHTTP60
34  With http
35    .Open "GET", url, False
36    .setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
37    .send
38
39    Dim trimmedResponseText As String
40    'JSONレスポンスボディの最初の[と最後の]を削除
41    trimmedResponseText = Mid(.responseText, 2, Len(.responseText) - 2)
42  End With
43  
44  Dim jsonResponses As Variant
45  Set jsonResponses = SplitJsonIssueListResult(trimmedResponseText)
46  
47  Dim aryCount As Long
48  aryCount = jsonResponses.Count - 1
49  
50  Dim responseDic() As Dictionary
51  ReDim responseDic(aryCount)
52  Dim i As Long
53  For i = 0 To aryCount
54    Dim issueObj As Object
55    Set issueObj = ParseJson(jsonResponses(i))
56    Set responseDic(i) = issueObj
57  Next i
58  
59  Dim issueSht As Worksheet
60  Set issueSht = ThisWorkbook.Worksheets("issue")
61  issueSht.UsedRange.Clear
62  
63  With issueSht
64    .Cells(1, 1) = ISSUE_KEY_NAME
65    .Cells(1, 2) = SUMMARY_NAME
66  
67    Dim writeRow As Long
68    writeRow = 2
69
70    For i = 0 To aryCount
71      .Cells(writeRow, 1) = responseDic(i)(ISSUE_KEY_NAME)
72      .Cells(writeRow, 2) = responseDic(i)(SUMMARY_NAME)
73      writeRow = writeRow + 1
74    Next i
75  End With
76  
77  issueSht.UsedRange.Borders.LineStyle = True
78  
79  Set configSht = Nothing
80  Set http = Nothing
81  Set issueSht = Nothing
82  Set issueObj = Nothing
83  
84  MsgBox "課題一覧を取得しました。", vbInformation
85  
86End Sub
87
88Private Function SplitJsonIssueListResult(json_result As String) As Variant
89  '課題一覧のJSONレスポンスを課題ごとに分割して配列で返す
90  
91  Dim re As New RegExp
92  re.Pattern = "{.*?""stars"":\[.*?\]}"
93  re.Global = True
94  
95  Set SplitJsonIssueListResult = re.Execute(json_result)
96  Set re = Nothing
97
98End Function

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

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

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