【VBA】VBAでBacklog APIを利用してユーザー情報を操作する

VBA

Backlogはタスクを管理するWebアプリケーションです。
APIが提供されているので、ブラウザ上のBacklogでできる操作をAPIから行えます。

Backlogの課題を操作する記事を以前書きましたが、今回はVBAからAPIを利用して
ユーザーの取得を行ってみます。

動作環境

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

事前準備

参照設定

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

  1. Microsoft XML v6.0
  2. Microsoft Scripting Runtime
  3. Microsoft VBScript Regular Expressions 5.5

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

VBAで参照設定を行う

VBA-JSONの導入

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

VBA-tools/VBA-JSON
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キーを取得する必要があります。

Backlog ヘルプセンター
Backlog ヘルプセンターではBacklogを初めて使う方向けの使い方ガイド、運用のコツやプロジェクト管理に役立つ活用ガイド、よくあるご質問などをご用意しております。ユーザーコミュニティでは他のユーザーとつながって、Backlogの疑問を解決することもできます。

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

ユーザーの一覧を取得する

Backlog APIを利用してスペースのユーザーの一覧を取得します。

userシートを事前に作成しておき、APIから取得した情報をuserシートに書き込みます。

 

Backlog APIを利用してユーザー情報の一覧を取得するコードです。

 

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

Excel VBA で サーバーが動いていないのにMSXML2.XMLHTTPのレスポンスが返る?|teratail
CentOSにてPython FlaskによるWebサーバーを立ち上げ、Excel VBAよりこのサーバーに対するHTTP送受信を試みています。VBAにて以下のコードのようにリクエストすると、一見、正常のレスポンスが返ってきます。(通信エラーなどは発生していません) Set o

 

Backlog APIの結果が複数の内容を含むもの(ユーザー一覧取得課題一覧取得など)ではレスポンスボディの最初に[と最後に]が付いています。事前準備で導入したVBA-JSONは[]が付いているとパースできないため括弧を削除しておきます。

 

VBA-JSONはBacklog APIの結果が複数の内容を含むもの(ユーザー一覧取得課題一覧取得など)で最後の内容しか取得できません。SplitJsonUserListResult内で正規表現を使用して、取得結果を1個1個のデータに分割し、配列として返しています。

GetUserListを実行するとユーザーの一覧がuserシートに表示されます。

コメント

  1. 田中 格 より:

    【疑問】下記の記述では「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ですが、私の環境ですと課題にカスタム属性を追加しています。
      推測になりますがカスタム属性の追加、もしくは追加したカスタム属性の内容によって
      []を削除する必要があるのではないかと思っています。