Backlogはタスクを管理するWebアプリケーションです。
APIが提供されているので、ブラウザ上のBacklogの操作をAPIから行えます。
Backlogの課題を操作する記事を以前書きましたが、今回はVBAからAPIを利用して
ユーザーの取得を行ってみます。
動作環境
- Windows10 Home 64bit
- Microsoft Office 365 Business
- Backlog フリープラン
事前準備
参照設定
以下の2つの参照設定を利用するので、VBAエディターの参照設定でチェックを入れます。
- Microsoft XML v6.0
- Microsoft Scripting Runtime
参照設定の方法は以下をご覧ください。
VBA-JSONの導入
Backlog APIでは結果がJSON形式で返ってきます。
VBAではJSONをパースする標準ライブラリがないので、VBA-JSONを利用します。
git cloneまたはzipファイルをダウンロードして、JsonConverter.basを
VBAのプロジェクトにインポートします。
導入方法はVBAエディターを開き、プロジェクトウィンドウでVBAProjectを
右クリックしファイルのインポートをクリックします。
VBA-JSONのJsonConverter.basを選択して「開く」をクリックします。
標準モジュールにJsonConverterが表示されれば、VBA-JSONの導入は完了です。
APIキーを取得
Backlog APIを利用するにはAPIキーを取得する必要があります。
configシートを用意し、B1セルに利用しているBacklogのURLと
B2セルに取得したAPIキーを入力しておきます。
ユーザーの一覧を取得する
Backlog APIを利用してスペースのユーザーの一覧を取得します。
userシートを事前に作成しておき、APIから取得した情報をuserシートに書き込みます。
Backlog APIを利用してユーザー情報の一覧を取得するコードです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 |
Option Explicit Private Const API_KEY_NAME As String = "apiKey" Private Const ID_NAME As String = "id" Private Const USER_NAME As String = "name" Public Sub GetUserList() 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/users" apiKey = configSht.Range("B2") Dim url As String url = spaceURL & apiURL & "?" & API_KEY_NAME & "=" & apiKey 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 userObj As Object Set userObj = ParseJson(.responseText) End With Dim userSht As Worksheet Set userSht = ThisWorkbook.Worksheets("user") userSht.UsedRange.Clear With userSht .Cells(1, 1) = ID_NAME .Cells(1, 2) = USER_NAME Dim writeRow As Long writeRow = 2 Dim i As Long For i = 1 To userObj.Count .Cells(writeRow, 1) = userObj(i)(ID_NAME) .Cells(writeRow, 2) = userObj(i)(USER_NAME) writeRow = writeRow + 1 Next i End With userSht.UsedRange.Borders.LineStyle = True Set configSht = Nothing Set http = Nothing Set userSht = Nothing Set userObj = Nothing MsgBox "ユーザー一覧を取得しました。", vbInformation End Sub |
|
1 2 3 4 |
With http .Open "GET", url, False .setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT" .send |
URLのキャッシュがあると、前のGETの結果を利用してしまうので
下記を参考にRequestHeaderに値を入力してsendします。
|
1 2 3 4 5 6 |
Dim i As Long For i = 1 To userObj.Count .Cells(writeRow, 1) = userObj(i)(ID_NAME) .Cells(writeRow, 2) = userObj(i)(USER_NAME) writeRow = writeRow + 1 Next i |
データの取得開始インデックスは i = 0 ではなく i = 1 から開始します。
GetUserListを実行するとユーザーの一覧がuserシートに表示されます。
コメント
【疑問】下記の記述では「VBA-JSONは[]が付いているとパースできない」となっていますができましたよ！
Backlog APIの結果が複数の内容を含むもの（ユーザー一覧取得や課題一覧取得など）ではレスポンスボディの最初に[と最後に]が付いています。事前準備で導入したVBA-JSONは[]が付いているとパースできないため括弧を削除しておきます。
Public Function CF31_GetProjects() As Variant()
‘——————————————————————————————————
‘ 31 プロジェクト一覧の取得
‘——————————————————————————————————
‘ URL ：https://developer.nulab.com/ja/docs/backlog/api/2/get-project-list/#プロジェクト一覧の取得
‘ 説明 ：プロジェクトの一覧を取得します
‘ メソッド：GET
‘ URL ：/api/v2/projects
‘ PARAM ：archived
‘ 真偽値 省略された場合は全てのプロジェクト
‘ falseの場合はアーカイブされていないプロジェクト、
‘ trueの場合はアーカイブされたプロジェクトを返します。
‘ 設定例 archived = False
‘ PARAM ：all
‘ 真偽値 ユーザが管理者権限の場合のみ有効なパラメータです。
‘ trueの場合はすべてのプロジェクト、
‘ falseの場合は参加しているプロジェクトのみを返します。初期値はfalse。
‘ 設定例 all=false
‘——————————————————————————————————
Dim WS1 As Worksheet
Set WS1 = □API設定ベース
Dim spaceURL As String
Dim apiURL As String
Dim apiKey As String
Dim WS2 As Worksheet
Set WS2 = □プロジェクト
spaceURL = WS1.Cells(2, 2)
apiKey = WS1.Cells(2, 3)
apiURL = “/api/v2/projects”
Dim Url As String
Url = spaceURL & apiURL & “?” & “apiKey” & “=” & apiKey
Dim params As New Dictionary
params.Add “archived”, “false”
params.Add “all”, “false”
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 ‘P3のFalse意味は後日調査が必要
.SetRequestHeader “If-Modified-Since”, “Thu, 01 Jun 1970 00:00:00 GMT” ‘キャッシュから情報をゲットしないようにする設定
.Send
End With
If ResponseErrorCheck(Http.ResponseText, “read”) Then
MsgBox (“プロジェクト情報の取得に失敗しました！”)
Exit Sub
Else
Dim jsonObj As Object
Set jsonObj = ParseJson(Http.ResponseText)
End If
Dim projects() As Variant
ReDim projects(1 To jsonObj.Count + 1, 1 To 11)
projects(1, 1) = “id”
projects(1, 2) = “projectKey”
projects(1, 3) = “name”
projects(1, 4) = “chartEnabled”
projects(1, 5) = “subtaskingEnabled”
projects(1, 6) = “projectLeaderCanEditProjectLeader”
projects(1, 7) = “useWikiTreeView”
projects(1, 8) = “textFormattingRule”
projects(1, 9) = “archived”
projects(1, 10) = “displayOrder”
projects(1, 11) = “useDevAttributes”
Dim iRow As Long
iRow = 2
Dim i As Long
For i = 1 To jsonObj.Count
projects(iRow, 1) = jsonObj(i)(“id”)
projects(iRow, 2) = jsonObj(i)(“projectKey”)
projects(iRow, 3) = jsonObj(i)(“name”)
projects(iRow, 4) = jsonObj(i)(“chartEnabled”)
projects(iRow, 5) = jsonObj(i)(“subtaskingEnabled”)
projects(iRow, 6) = jsonObj(i)(“projectLeaderCanEditProjectLeader”)
projects(iRow, 7) = jsonObj(i)(“useWikiTreeView”)
projects(iRow, 8) = jsonObj(i)(“textFormattingRule”)
projects(iRow, 9) = jsonObj(i)(“archived”)
projects(iRow, 10) = jsonObj(i)(“displayOrder”)
projects(iRow, 11) = jsonObj(i)(“useDevAttributes”)
iRow = iRow + 1
Next
‘UsedRangeは最新の状態を取得できないバグがあるので別の方法で範囲を確定する
F31_GetProjects = projects
WS2.UsedRange.ClearContents
WS2.UsedRange.Borders.LineStyle = False
projects(1, 1) = projects(1, 1) & “(” & jsonObj.Count & “)” & vbLf & Format(Now(), “yy/mm/dd hh:mm:ss”)
WS2.Cells(1, 1).Resize(UBound(projects, 1), UBound(projects, 2)) = projects
Dim r
Set r = FindLastCell(WS2)
WS2.Range(WS2.Cells(1, 1), WS2.Cells(r.Row, r.Column)).Borders.LineStyle = True
WS2.Range(WS2.Cells(1, 1), WS2.Cells(r.Row, r.Column)).RowHeight = 20
WS2.Rows(1).RowHeight = 45
‘WS2.Activate
Set WS1 = Nothing
Set WS2 = Nothing
Set Http = Nothing
Set jsonObj = Nothing
‘MsgBox “プロジェクト一覧を取得しました。”, vbInformation
End Function
Public Function CF_GetProjectsCnt() As Long
‘——————————————————————————————————
‘ 31 プロジェクト一覧の取得
‘——————————————————————————————————
‘ URL ：https://developer.nulab.com/ja/docs/backlog/api/2/get-project-list/#プロジェクト一覧の取得
‘ 説明 ：プロジェクトの一覧を取得します
‘ メソッド：GET
‘ URL ：/api/v2/projects
‘ PARAM ：archived
‘ 真偽値 省略された場合は全てのプロジェクト
‘ falseの場合はアーカイブされていないプロジェクト、
‘ trueの場合はアーカイブされたプロジェクトを返します。
‘ 設定例 archived = False
‘ PARAM ：all
‘ 真偽値 ユーザが管理者権限の場合のみ有効なパラメータです。
‘ trueの場合はすべてのプロジェクト、
‘ falseの場合は参加しているプロジェクトのみを返します。初期値はfalse。
‘ 設定例 all=false
‘——————————————————————————————————
‘ ParseJson(text)：パースしたデータはDictionary型｡内部の配列はCollection型。
‘——————————————————————————————————
Dim WS1 As Worksheet
Set WS1 = □API設定ベース
Dim spaceURL As String
Dim apiURL As String
Dim apiKey As String
Dim WS2 As Worksheet
Set WS2 = □プロジェクト
spaceURL = WS1.Cells(2, 2)
apiKey = WS1.Cells(2, 3)
apiURL = “/api/v2/projects”
Dim Url As String
Url = spaceURL & apiURL & “?” & “apiKey” & “=” & apiKey
Dim params As New Dictionary
params.Add “archived”, “false”
params.Add “all”, “false”
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 ‘P3のFalse意味は後日調査が必要
.SetRequestHeader “If-Modified-Since”, “Thu, 01 Jun 1970 00:00:00 GMT” ‘キャッシュから情報をゲットしないようにする設定
.Send
End With
If ResponseErrorCheck(Http.ResponseText, “read”) Then
MsgBox (“プロジェクト情報の取得に失敗しました！”)
Exit Function
Else
Dim jsonObj As Object
Set jsonObj = ParseJson(Http.ResponseText)
End If
CF_GetProjectsCnt = jsonObj.Count
End Function
田中さん
コメントありがとうございます。
一覧取得のAPIだとパースできるAPIとできないAPIがあるみたいです。
■[]を削除せずにパースできたAPI
・プロジェクト一覧取得
■[]削除後、正規表現で分割しないとパースできないAPI
・課題一覧取得
課題一覧取得のAPIですが、私の環境ですと課題にカスタム属性を追加しています。
推測になりますがカスタム属性の追加、もしくは追加したカスタム属性の内容によって
[]を削除する必要があるのではないかと思っています。