VBAとMicrosoft Graph APIの連携 – Planner編
Microsoft 365にはPlannerと呼ばれるメンバーで利用するタスク管理プログラムが用意されています。しかし、実際に使ってみると主要な項目は抑えられているものの、若干使いにくい。という事でプログラムから利用できる形にして、インターフェースは別に用意するといった作業を今行っています。
そしてプログラムから利用できるようにする為のものがGraph APIであり、タスクの登録・更新・一覧の取得をやってみたいと思います。
図：シンプルなタスク一覧画面
リンク
目次
今回利用するサービスやファイル等
- Graph APIで読み書きサンプル – Excelファイル
- Planner
- Microsoft Graph API
- Puppeteer-core
- pkg – npm
- Graph API認証用のEXE
今回は、いつものIE11を使っての認証ではなく、以下のエントリーにあるようにPuppeteerを利用したOAuth2.0認証をするように変更しています。Node.jsにて作成し、EXEにパッケージ。これをVBAから叩いて利用しています。
シートの設定にグループIDおよびプランIDの入力欄があるので入力してから利用して下さい。
Graph API認証用のEXEはサンプルファイルと同じディレクトリに入れておく必要があります。
新方式が登場しました
IE11の廃止に伴い、SeleniumやNode.jsやらといった手段を使わず、またPuppeteerと同様の手法（CDPを叩く）でVBAとEdge/ChromeのみでOAuth2.0認証する手段が登場しました。スクレイピングも可能になっています。以下のエントリーを参考にしてみてください。この手法は最も制限が無く、もっともすぐれた選択肢になると思います。
事前準備
これまで、ElectronやGoogle Apps ScriptなどでGraph APIを叩く準備は構築してきていますが、VBAからも同じような形で事前準備が必要になります。以下の手順でClient IDとClient Secretを取得します（実用時はAccess Tokenなどの暗号化などの対処が別途必要になります）。
プロキシー設定を調べる
企業内で使う場合、ウェブアクセスにプロキシーを使ってる場合には、VBAからアクセスする場合もその設定を利用する必要性があります。プロキシーを経由しなければ外に出ることができないので、プログラムが動作しません。プロキシーの設定はいろいろなパターンがありますが、一般的な設定の調べ方は以下の通り。
サーバーのアドレスとポート番号について、http://を除外して、コロンでポート番号でつなげて利用します。（例：hiroproxy.net:8080）
- コントロールパネルより「インターネットオプション」を開く
- 「接続」タブを開き、「LANの設定」を開く
- この画面でプロキシーサーバの部分にアドレスとポート名が入ってるならばこれを控えておく。
- 場合によっては、詳細設定の中の「HTTP」で指定してるサーバーアドレスとポート番号を控えておく。
- 自動構成スクリプトを使ってる場合、そこに指定されてるアドレスのファイルの中に、様々なプロキシーアドレスが入っていますので、それを一旦ダウンロードして中身をテキストエディタで開いてみる（通常はpacというファイル）
- 5.のケースの場合、pacファイル内はIF文を使ってアクセスするサイト別にプロキシーが設定されてることが多いので、もっとも一般的なサイトアクセスもしくはBoxについてだけ定義している場合には、そのサーバーアドレスとポート番号を控えておく。
なお、Proxyを使わない場合には、コード内のproxyuriおよびWinHTTPの.setProxy 2, proxyuriについては、コメントアウトしておかないと「定数式が必要です」というエラーが出てしまうので注意してください。
図：プロキシー設定がない場合はこの作業は不要です。
Plannerの追加・更新の為に必要な情報を収集する
PlannerをGraph APIで実行するのに必要な情報は、以下のように取得する事が出来ます。下記以外にもbucketidやtaskidなどが実際には必要ですが、下記の情報でリクエストを投げる事で入手が可能であるため、プログラム自体が必要とするのは、groupIdとplanIdだけで十分です。
- Plannerで新しいプランを作成する
- 作成したプランを開く
- URLの中にあるgroupId=以下の部分が、groupIdになります。
- 同じくURLの中にあるplanId=以下の部分が、planIdになります。
Graph Explorerで上記の情報を元に、リクエストをする際にアクセス許可に管理者権限を要求されるものが出てきたりしますが、実際にはこれらに同意せずとも、リクエストを実行する事が可能です（つまり必須ではない）
図：求められたアクセス許可
Azureでプロジェクトを作成
今回のプログラムは管理者権限は不要です（Graph Explorerだと管理者権限の必要なスコープが出てきますが、実際には不要です）
- アプリの登録にて登録を開始する
- 新規登録をクリックする
- 名前を入力（今回はplannermanと入力しました）、リダイレクトURIは「webを選択」し、今回URLはこのサイトのURLを入力。
- 登録ボタンをクリックする
- 出てきた中で、「アプリケーション（クラと書かれているのがクライアントID」なので、このコードをメモしておく
- 左サイドバーより、「証明書とシークレット」をクリック
- 「新しいクライアントシークレット」をクリックする
- 今回は特に有効期限を設けないで追加をクリック
- これで「値」に「クライアントシークレット」が生成されて手に入りました。このシークレットはこの時だけしか表示されないので、注意してください（IDは不要なのでメモらなくていいです）
- つづけて、左サイドバーより「APIのアクセス許可」をクリックする
- Microsoft APIの中にある「Microsoft Graph」をクリックする。
- 「委任されたアクセス許可」をクリックする
- デフォルトでUser.ReadがすでにONなので、今回はopenid, offline_access, profile, Tasks.ReadWrite.Shared, Tasks.Read, Tasks.ReadWriteを検索してONにしましょう。
- アクセス許可の追加をクリックする
- 追加出来たら、xxxxxに管理者の同意を与えますをクリックします。すると、状態が緑色になります。今回は管理者の権限を要求するものは無いのでしなくても大丈夫だと思う
- 次に左サイドバーより「認証」をクリック
- 暗黙の付与にて、「アクセストークン」にチェックを入れる
- サポートされているアカウントの種類に於いては、「マルチテナント」にしておきました。
- 保存をクリック
- 概要のエンドポイントをクリックすると、いろいろなエンドポイントURLが出る。
- 概要のディレクトリ（テナントの数値はメモっておきます。あとでプログラム中で使用します。
- デフォルトでは組織アカウントでなければOAuth2.0認証が出来ません。
※3.でWebを選ばないSPAを選んでしまうと、Proof Key for Code Exchange by OAuth Public Clientsといったエラーが出てしまい認証ができませんので注意。
図：アプリの登録から全ては始まります。
図：Graphを選択する
図：アクセス権限付与した状態
図：認証の設定変更に注意
認証を実行するコード
冒頭にあるように、いつものようにIE11で認証を実行してAccess Tokenを取得するのではなく、Windows11 64bitを見据えて、今回はNode.js + Puppeteer + pkgにてWindows用のEXEを作っており、VBAから叩いてAuthcodeを取得する所まではそちらで対応しています。
VBA側コード
'OAuth認証用
Public Const tenant As String = "ここにテナントIDを入れる"
Public Const client_id As String = "ここにクライアントIDを入れる"
Public Const client_secret As String = "ここにクライアントシークレットを入れる"
Public Const redirecturl As String = "ここにリダイレクトURLを入れる"
Public Const oauthurl As String = "https://login.microsoftonline.com/"
Public Const tokenurl As String = "https://login.microsoftonline.com/common/oauth2/v2.0/token"
Public Const endpoint As String = "https://graph.microsoft.com/beta/"
'プロキシー設定
Public Const proxyuri As String = "ここ二プロキシーURLを入れる"
’利用してるスコープ（スペースで区切るけれど、%20で置き換える）
Public Const scope As String = "User.Read%20offline_access%20Tasks.ReadWrite.Shared%20profile%20openid%20Tasks.ReadWrite%20Tasks.Read"
'Box APIの認証を行う
Public Function GraphAuthorization()
'iniファイルからidとpassを読み込み
Dim authcode As String
'WSHの用意
Dim WSH, wExec, sCmd As String, Result As String
Set WSH = CreateObject("WScript.Shell")
'認証用URLを構築
Dim oauthpage As String
Dim param As String
'パラメータは&は%26として渡さないと引数が壊れる（スペースは
param = "%26response_type=code%26scope=" & scope & "%26redirect_uri=" & redirecturl
oauthpage = oauthurl & tenant & "/oauth2/v2.0/authorize?client_id=" & client_id & param
'コマンドラインの組み立てと実行
sCmd = ThisWorkbook.Path & "\index-win.exe -g " & oauthpage
Set wExec = WSH.Exec("%ComSpec% /c " & sCmd)
'ステータスを見てループ
Do While wExec.Status = 0
DoEvents
Loop
'標準出力内容を取得
authcode = wExec.StdOut.ReadAll
'取得したコードからcode=以下を取得する
Debug.Print authcode
'終了処理
Set wExec = Nothing
Set WSH = Nothing
End Function
- Authenticate Codeを取得するまでのコードです。
- Node.jsで作られてるexeに対して、引数で認証用URLを渡し、相手側のプログラムが完了するまで待機させてあります
- scopeにはAzure側で利用するスコープ名を半角スペースで区切りますが、半角スペースは%20として指定しています
- &で引数を区切り渡すと壊れるので、こちらも%26として置き換えて指定（相手側のプログラムでこれは&に変換させています）
- 出力を受け取ったら、今回はDebug.Printで表示していますが、次の「Access Token」を取得するプログラムへ渡します。
Node.js側コード
今回は、command-line-argsおよびpuppeteer-coreを利用して、VBAからのコマンドライン引数で認証用URLを取得し、PuppeteerでMicrosoft Graph APIの認証⇒Authenticate Codeの取得までを担当させています。それ以降はVBA単体で行えます。EXEの作成や詳細については、以下のエントリーに記載していますので、ここでは省略致します。
認証を実行する
ここまでで、OAuth2.0認証のAuthenticate Codeの取得までが装備出来ているので、VBA側で「GraphAuthorization」を実行します。まだ、今回の装備ではAccess Tokenなどは取得出来ていないので、Access Tokenの取得やRefresh Tokenの処理については過去のエントリーで紹介しているので、以下のエントリーを参照して下さい。
実行すると
- 用意しておいた認証用URLをindex-win.exeに引き渡す
- Puppeteerにてインストール済みのChromeもしくはChromium Edgeが起動し認証ページが開かれる
- ログイン作業をして、「サインインを維持したままにするか？」では「はい」をクリックする
- リダイレクトURL先にcode=付きのURLで飛ばされて、Authenticate Codeを取り出す
という作業が行われます。
図：認証を実行してる様子
Plannerを読み書きしてみる
Plannerのデータはplan => bucket => taskという階層で登録されており、更にtaskの下に説明文等の情報が詳細情報として分けられてるため、完全なタスク情報を取得する為には、数回Graph APIをリクエストする必要性があります。また、現在、タスクに対するコメントは取得が出来ません。
更にリクエストバージョンがBetaでなければ、priorityが取得出来ない為、今回のリクエストはv1.0ではなくBetaを利用しています。
図：これらの情報を取得する
Plan内のバケット一覧を取得する
Planの中には初期で用意されてるTo Doと呼ばれるバケット以外は存在しません。タスクはそれらのバケット以下に登録されるので、まずはPlan内にあるバケットの一覧を取得する必要があります。この時に利用するのはplanIdで、取得できるbucketidをExcelシートに書き出します。
この時に利用するAPIのエンドポイントは、「https://graph.microsoft.com/beta/planner/plans/ここにplanIdを入れる/buckets」となります（GETリクエスト）。
この時のレスポンス成功のコードは200となります。
VBAのコード
'バケット一覧を取得する
Public Function getBucketList()
Dim authcode As String
authcode = ""
'planIdをセルから取得
Dim planid As String
planid = ThisWorkbook.Worksheets("設定").Range("B2").Value
'エンドポイントURLを構築
Dim requrl As String
requrl = endpoint & "planner/plans/" & planid & "/buckets"
'Access Tokenの取得と失効チェック
Dim tokenstatus As Boolean
tokenstatus = checkExpireToken() 'Access Tokenの取得と失効チェック
'Tokenの状況に応じて処理を分岐
Select Case tokenstatus
Case True
'無事にTokenは生きてるので何もしない
Case False
'refresh token使って新しいTokenを取得
ret = GetAccessToken(authcode, -1)
'取得結果を判定
If ret = True Then
'無事に取得できているのでスルーする
Else
'取得失敗
MsgBox "Access Tokenの取得に失敗しました。"
Exit Function
End If
End Select
'JSON受信用
Dim Json As Object
Dim resteams As Object
'Access Tokenを取得する
Dim access_token As String
access_token = IniRead("USER", "access_token", "")
'リクエストを実行
Dim reccnt As Integer
Dim counter As Integer
Dim tempcnt As Integer
Dim totalcnt As Integer
'リプライ取得用
Dim oWinHttpReq
Set oWinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", requrl, False
.setProxy 2, proxyuri
.SetRequestHeader "Authorization", "Bearer " & access_token
.send
'返ってきた値をもとにデータを処理
Select Case .Status
Case 200
'JSON文字列より各種値を取得・保存
'パース関数でJSONオブジェクトを取得
Set Json = JsonConverter.ParseJson(.ResponseText)
'レコード数を調べる
totalcnt = Json("value").Count - 1
reccnt = Json("value").Count - 1
'スレッドを回して各種データを配列に突っ込む
'配列を用意する
Dim recarr() As Variant
Dim msgid As Variant
Dim teamschild As String
Dim rescnt As Integer
ReDim recarr(10000, 7) '10000レコードに拡張
counter = 0
'JSONの中でvalueの中身を取得する
For Each records In Json("value")
'親スレッドをまずは取得する
'配列に値を追加
recarr(counter, 0) = records("id") 'バケットID
recarr(counter, 1) = records("name") 'バケット名
'カウンタを加算
counter = counter + 1
Next
'配列を縮める
'一時的な配列を用意する
Dim tempArray()
'Transpose関数を使って配列に突っ込む
tempArray = WorksheetFunction.Transpose(recarr)
'ReDimで配列の要素数を再定義
ReDim Preserve tempArray(1 To UBound(tempArray, 1), 1 To counter + 1)
'元に戻す
recarr = WorksheetFunction.Transpose(tempArray)
'書き込みレコード数
Dim editrec As Integer
editrec = counter + 1
'配列をシートに書き出し
ThisWorkbook.Worksheets("バケット").Range("A2:B" & editrec) = recarr
'終了メッセージ
MsgBox "データの取得が完了しました。"
Case Else
MsgBox "レコードの取得に失敗しました"
End Select
End With
End Function
- GETでリクエストしてレスポンスデータのJSONを分解してバケットシートに書き込みをしています。
- 書き込み先はテーブルとなっています。
レスポンスデータ
{
"@odata.context": "https://graph.microsoft.com/v1.0/$metadata#Collection(microsoft.graph.plannerBucket)",
"@odata.count": バケットの数,
"value": [
{
"@odata.etag": "W/\"JzVVVVVVVVVVVVVVVVSCc=\"",
"name": "バケット名が入ってる",
"planId": "ここにプランIDが入ってる",
"orderHint": "",
"id": "ここにバケットIDが入ってる"
}
]
}
レスポンスデータで利用するのは、valueの中にあるnameとidの２つのみです。このidがbucketidになります。
バケット内のタスク一覧を取得する
前述のplanの中にあるbucketidを元に、このバケットに登録されているタスクの一覧を取得します。この時に利用するのがbucketidで、これがこのプログラムで最も重要なリクエストになります。
この時に利用するAPIのエンドポイントは、「https://graph.microsoft.com/beta/planner/buckets/ここにbucketidを入れる/tasks」となります（GETリクエスト）
※他にもユーザIDに基づいてユーザに割り振られたタスクを取得するAPIもあります。
この時のレスポンス成功のコードは200となります。
VBAのコード
'エンドポイントURLを構築
requrl = endpoint & "planner/buckets/" & bucketid & "/tasks"
'Access Tokenの取得と失効チェック
tokenstatus = checkExpireToken() 'Access Tokenの取得と失効チェック
'Tokenの状況に応じて処理を分岐
Select Case tokenstatus
Case True
'無事にTokenは生きてるので何もしない
Case False
'refresh token使って新しいTokenを取得
ret = GetAccessToken(authcode, -1)
'取得結果を判定
If ret = True Then
'無事に取得できているのでスルーする
Else
'取得失敗
MsgBox "Access Tokenの取得に失敗しました。"
Exit Function
End If
End Select
'Access Tokenを取得する
access_token = IniRead("USER", "access_token", "")
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", requrl, False
.setProxy 2, proxyuri
.SetRequestHeader "Authorization", "Bearer " & access_token
.send
On Error Resume Next
'返ってきた値をもとにデータを処理
Select Case .Status
Case 200
'JSON文字列より各種値を取得・保存
'パース関数でJSONオブジェクトを取得
Set Json = JsonConverter.ParseJson(.ResponseText)
'配列を初期化する
Erase recarr
Erase tempArray
ReDim recarr(10000, 11) '10000レコードに拡張
counter = 0
'JSONの中でvalueの中身を取得する
For Each records In Json("value")
'親スレッドをまずは取得する
'配列に値を追加
recarr(counter, 0) = records("id") 'タスクID
recarr(counter, 1) = records("@odata.etag") 'etag
recarr(counter, 2) = records("bucketId") 'bucketID
recarr(counter, 3) = records("title") 'タスク名
recarr(counter, 4) = records("priority") '優先度
recarr(counter, 5) = records("startDateTime") '開始日
recarr(counter, 6) = records("dueDateTime") '終了日
recarr(counter, 7) = records("percentComplete") '進行状況
'アサインの有無をチェック
test = records("assignments").Count
If test = 0 Then
recarr(counter, 8) = "" 'アサイン先
Else
test2 = records("assignments").Items
recarr(counter, 8) = test2(0)("assignedBy")("user")("id")
End If
'ラベルを取得する（appliedCategories）
templabel = ""
labelcnt = 0
labelman = 0
'ラベルのカウント
labelcnt = records("appliedCategories").Count
If labelcnt = 0 Then
recarr(counter, 9) = ""
Else
For Each Key In records("appliedCategories").Keys
'keyの値を取得する
If records("appliedCategories")(Key) = True Then
'ラベル用配列をredim
ReDim Preserve labelarr(labelcnt - 1)
'labelarrに値を追加
tempkey = Key
labelarr(labelman) = tempkey
'カウンタを回す
labelman = labelman + 1
Else
'何もしない
End If
Next Key
'ラベルデータをjoinでカンマ区切り結合して追加する
recarr(counter, 9) = Join(labelarr, ",")
End If
- 上記のコードは処理の途中部分になりますがエンドポイントとしてbucketidをつけてリクエストします。
- 返り値のうち、必要な項目だけを取り出してrecarrに追加しています。
- アサイン先は、Countにて存在確認した後で、存在すればそのユーザのIDを格納します。
- ラベルも複数存在するケースがあるので、Countにて存在確認した後で、key名を一時配列に格納。その後Joinにてカンマ区切りにして格納します。
なお、このrecarrのデータをテーブルに追記する形で追加をしなければならないので、以下のコードを利用して、２つ以上のバケットのタスク内容を順次追加しています。
'空白配列を縮小する
'ループで調査
For j = 1 To UBound(recarr) + 1
'1個目のデータを調査する
tempcheck = recarr(j, 0)
If tempcheck = "" Then
Exit For
Else
countman = countman + 1
End If
Next
'書き出し用配列を定義する
ReDim Preserve temparr(countman, 11)
For k = 0 To UBound(recarr)
temparr(k, 0) = recarr(k, 0)
temparr(k, 1) = recarr(k, 1)
temparr(k, 2) = recarr(k, 2)
temparr(k, 3) = recarr(k, 3)
temparr(k, 4) = recarr(k, 4)
temparr(k, 5) = recarr(k, 5)
temparr(k, 6) = recarr(k, 6)
temparr(k, 7) = recarr(k, 7)
temparr(k, 8) = recarr(k, 8)
temparr(k, 9) = recarr(k, 9)
temparr(k, 10) = recarr(k, 10)
temparr(k, 11) = recarr(k, 11)
Next
'現在のテーブルのレコード数を取得する
tablerow = Worksheets("タスク一覧").ListObjects("task").ListRows.Count
'テーブル最終行に配列を書き出す
ThisWorkbook.Sheets("タスク一覧").Range("A" & tablerow + 2).Resize(UBound(temparr), 12) = temparr
- 10000レコードに一旦広げてからデータを入れてるため、書き出し時には空白行は削る必要があるため。
- ReDim Preserveにて実際に存在するレコード分に相当する配列を用意し、そこへ既存のrecarrからのデータをコピー。これを書き出すようにしています。
- 最後のコードで、テーブルの最終行の位置を把握して、ここにtemparrを追記するようにしています。
図：無事に現在のタスクリスト全部を取得出来た
レスポンスデータ
{
"@odata.context": "https://graph.microsoft.com/v1.0/$metadata#Collection(microsoft.graph.plannerTask)",
"@odata.count": 登録タスクの数,
"value": [
{
"@odata.etag": "W/\"JzEtVVVVVVVVVVVVVVVV=\"",
"planId": "",
"bucketId": "",
"title": "ここにタスク名が入ってる",
"orderHint": "",
"assigneePriority": "",
"percentComplete": ここに進行状況が入ってる（50で処理中）,
"startDateTime": "ここに開始日付が入ってる",
"createdDateTime": "2022-04-12T03:36:28.6211642Z",
"dueDateTime": "ここに終了日付が入ってる",
"hasDescription": true,
"previewType": "reference",
"completedDateTime": null,
"completedBy": null,
"referenceCount": 1,
"checklistItemCount": 0,
"activeChecklistItemCount": 0,
"conversationThreadId": "",
"priority": ここに優先度が入ってる,
"id": "ここにタスクのIDが入ってる",
"createdBy": {
"user": {
"displayName": null,
"id": "作成者のIDが入ってる"
}
},
"appliedCategories": {
"category1": true,
"category13": true
},
"assignments": {
"アサインのIDが入ってる": {
"@odata.type": "#microsoft.graph.plannerAssignment",
"assignedDateTime": "アサインした日付が入ってる",
"orderHint": "",
"assignedBy": {
"user": {
"displayName": null,
"id": "アサインした対象者のIDが入ってる"
}
}
}
}
}
]
}
- percentCompleteが50で処理中、100で完了済みとなります。
- priorityの値は、9=低・5=重要・3=中・1=緊急となります。
- idがtaskidとなります。これを元に詳細なデータを取得することになります。
- 他にもchecklistなども取得出来るようですが、今回はスルーしています。
- assignmentsにタスクを割り振った相手の情報が入っています。対象者のIDは個別のM365上のIDとなります。
- appliedCategoriesが、「ラベル」に該当します。これを応用して、詳細な進捗状況の管理に使ったり可能です。
- この段階では、「メモ」「添付ファイル」に関しての情報が取得出来ないので、taskidを利用して追加取得することになります。
- この時に表示されてる「@odata.etag」の値は更新時に必要となるため、データ取得時に控えておく必要があります。
タスクの詳細情報を取得する
前述までで殆どの情報が取得出来ているのですが、メモと添付ファイルに関する情報が取得出来ていないので、さらにリクエストをしてタスクの詳細を取得させます。この時に利用するのがtaskidであり、これを元にリクエストをして追加取得します。
この時に利用するAPIのエンドポイントは、「https://graph.microsoft.com/beta/planner/tasks/ここにタスクのIDを入れる/details」（GETリクエスト）
この時のレスポンス成功のコードは200となります。
VBAのコード
▼前回の続き
Dim taskchild as String
Dim tokenstatus as Boolean
Dim ret as Variant
Dim access_token as String
Dim tomato, resplan
'説明文と添付ファイルを取得する
taskchild = endpoint & "planner/tasks/" & records("id") & "/details"
'トークンステータスチェック
tokenstatus = checkExpireToken()
'Tokenの状況に応じて処理を分岐
Select Case tokenstatus
Case True
'無事にTokenは生きてるので何もしない
Case False
'refresh token使って新しいTokenを取得
ret = GetAccessToken(authcode, -1)
'取得結果を判定
If ret = True Then
'無事に取得できているのでスルーする
Else
'取得失敗
MsgBox "Access Tokenの取得に失敗しました。"
Exit Function
End If
End Select
'アクセストークンを取得
access_token = IniRead("USER", "access_token", "")
'HTTPリクエスト
oWinHttpReq.Open "GET", taskchild, False
oWinHttpReq.setProxy 2, proxyuri
oWinHttpReq.SetRequestHeader "Authorization", "Bearer " & access_token
oWinHttpReq.send
'返ってきた値をもとにデータを処理
Select Case oWinHttpReq.Status
Case 200
'JSON文字列より各種値を取得・保存
'Jsonを返す
tomato = oWinHttpReq.ResponseText
Set resplan = JsonConverter.ParseJson(tomato)
'説明文を取り出す
recarr(counter, 10) = resplan("description")
'ファイルURLだけを取り出す
test = resplan("references").Count
If test = 0 Then
recarr(counter, 11) = ""
Else
For Each Key In resplan("references").Keys
recarr(counter, 11) = DEcodeURLMSHTML(Key)
Next Key
End If
Case Else
'エラーを返す
MsgBox "タスクの詳細取得に失敗しました"
Exit Function
End Select
'URLデコードする関数
Function DEcodeURLMSHTML(ByVal sWord As String) As String
Dim d As Object
Dim elm As MSHTML.HTMLSpanElement
Dim objD As HTMLDocument: Set objD = New MSHTML.HTMLDocument
sWord = Replace(sWord, "\", "\\")
sWord = Replace(sWord, "'", "\'")
Set d = CreateObject("htmlfile")
Set elm = objD.createElement("span")
elm.setAttribute "id", "result"
objD.appendChild elm
objD.parentWindow.execScript "document.getElementById('result').innerText = decodeURIComponent('" & sWord & "');", "JScript"
DEcodeURLMSHTML = elm.innerText
End Function
- 前回のタスクの内容の続きになります。その際にrecords("id")でタスクIDを取得しておき、これを元にエンドポイントを構築します。
- リクエスト結果のうちdescriptionが説明文になります。
- ファイルのURLはちょっと取り出すのが厄介です（JSON keyの名前になってしまってるため）。referencesに登録があるので、ない場合は0が返ってくる。0じゃない場合は、.keysで回してkey名を取得し、これを配列に格納します。
- ファイルURLはURLエンコードされてしまってるのでDEcodeURLMSHTML関数にてデコードしてから格納します。
レスポンスデータ
{
"@odata.context": "https://graph.microsoft.com/beta/$metadata#planner/tasks('')/details/$entity",
"@odata.etag": "W/\"JzEtVVVVVVVVVVVVVVVVVVVVVVVV"",
"description": "ここにメモの内容が入ってる",
"previewType": "reference",
"id": "",
"references": {
"ここに添付ファイルのURLが入ってる": {
"@odata.type": "#microsoft.graph.plannerExternalReference",
"alias": "添付の表示するテキストが入ってる",
"type": "Other",
"previewPriority": "",
"lastModifiedDateTime": "2022-04-12T03:37:49.40426Z",
"lastModifiedBy": {
"user": {
"displayName": null,
"id": "追加した者のIDが入ってる"
}
}
}
},
"checklist": {}
}
- 今回はファイルそのものではなく、Boxの対象のファイルのURLをただ入れてるだけなので、referencesのURLを取得する必要があります。
- descriptionの中にメモの中身が入っている。
- checklistを登録している場合は、ここに詳細が出てきます。
- この中に入ってる@odata.etagの値はタスクを更新する度に変化し、更新時や削除時に必要となる大切な値なので、控えておきます。
タスクを新規登録する
タスクを新規登録する為には、planId・bucketIdが必要になります。同時にタスク名を登録する必要があります。また、リクエストヘッダーには「application/json」が必要になります。またリクエスト時に同時にタスクに対して色々と初期値をセットする場合には、plannerTaskの項目を要求本文に追加する事で、セットする事が可能です。
この時に利用するAPIのエンドポイントは「https://graph.microsoft.com/beta/planner/tasks」となります（POSTリクエスト）
※またリクエスト結果（201）のレスポンスデータには前述のように初期値の内容がすべて返ってきます。
VBAのコード
'タスクを投稿する
Public Function addNewtask()
Dim authcode As String
authcode = ""
'エンドポイントURLを構築
Dim requrl As String
requrl = endpoint & "planner/tasks"
'JSON受信用
Dim Json As Object
Dim resteams As Object
'リクエストボディ
Dim planid As String
Dim bucketid As String
Dim tasktitle As String
planid = "ここにプランIDを入れる"
bucketid = "ここにバケットIDを入れる"
tasktitle = "テストタスクの投稿"
'リクエスト用のパラメータを構築
Dim JsonObject As Object
Set JsonObject = New Dictionary
JsonObject.Add "planId", planid
JsonObject.Add "bucketId", bucketid
JsonObject.Add "title", tasktitle
'Access Tokenの取得と失効チェック
Dim tokenstatus As Boolean
Dim ret As Variant
Dim access_token As String
tokenstatus = checkExpireToken() 'Access Tokenの取得と失効チェック
'Tokenの状況に応じて処理を分岐
Select Case tokenstatus
Case True
'無事にTokenは生きてるので何もしない
Case False
'refresh token使って新しいTokenを取得
ret = GetAccessToken(authcode, -1)
'取得結果を判定
If ret = True Then
'無事に取得できているのでスルーする
Else
'取得失敗
MsgBox "Access Tokenの取得に失敗しました。"
Exit Function
End If
End Select
'Access Tokenを取得する
access_token = IniRead("USER", "access_token", "")
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", requrl, False
.setProxy 2, proxyuri
.SetRequestHeader "Content-Type", "application/json"
.SetRequestHeader "Authorization", "Bearer " & access_token
.send JsonConverter.ConvertToJson(JsonObject)
Debug.Print .Status
'返ってきた値をもとにデータを処理
Select Case .Status
Case 201
'レスポンスヘッダを取得
Debug.Print .getAllResponseHeaders()
'終了メッセージ
MsgBox "タスク登録が完了しました。"
Case Else
MsgBox "タスク登録に失敗しました"
End Select
End With
End Function
- DictionaryにてリクエストボディのJSONを構築する（プランIDとバケットIDが必要です）
- POSTにて送信する際に、JsonConverter.ConvertToJsonにてJSONへと変換する必要があります。
- .SetRequestHeader "Content-Type", "application/json"の追加が必要です
- 201が返ってきたら投稿成功です。
- 必要に応じて、リクエストボディに項目を追加すれば初期値をセットした状態で投稿可能です。
図：無事に投稿できました。
リクエスト要求本文
{
"planId": "ここにプランIDを入れる",
"bucketId": "ここにバケットIDを入れる",
"title": "ここにタスク名を入れる",
"assignments": {}
}
- 最低限上記のリクエスト要求は必要になります。
タスクを更新する
タスク内容の更新がやや難しい内容です。「バケット内のタスク一覧を取得する」の際に取得した「@odata.etag」の値がリクエストに必須になります。また、リクエストURLには対象のtaskidも必要になります。
また、リクエストヘッダには、「application/json」の他に「If-Match:@odata.etagの値」、「Prefer: return=representation」の追加が必要になります。
この時に利用するAPIのエンドポイントは「https://graph.microsoft.com/beta/planner/tasks/ここにtaskidを入れる」となります（PATCHリクエスト）
※またリクエスト結果（200）のレスポンスデータには前述のように初期値の内容がすべて返ってきます。
VBAのコード
'タスクを更新する
Public Function edittask()
Dim authcode As String
authcode = ""
'エンドポイントURLを構築
Dim requrl As String
Dim taskid As String
taskid = "ここにタスクIDを入れる"
requrl = endpoint & "planner/tasks/" & taskid
'@odata.etagの値
Dim etag As String
etag = "ここに@odata.etagの値を入れる"
'JSON受信用
Dim Json As Object
Dim resteams As Object
'リクエストボディ
'リクエスト用のパラメータを構築
Dim JsonObject As Object
Set JsonObject = New Dictionary
JsonObject.Add "percentComplete", 50
'Access Tokenの取得と失効チェック
Dim tokenstatus As Boolean
Dim ret As Variant
Dim access_token As String
tokenstatus = checkExpireToken() 'Access Tokenの取得と失効チェック
'Tokenの状況に応じて処理を分岐
Select Case tokenstatus
Case True
'無事にTokenは生きてるので何もしない
Case False
'refresh token使って新しいTokenを取得
ret = GetAccessToken(authcode, -1)
'取得結果を判定
If ret = True Then
'無事に取得できているのでスルーする
Else
'取得失敗
MsgBox "Access Tokenの取得に失敗しました。"
Exit Function
End If
End Select
'Access Tokenを取得する
access_token = IniRead("USER", "access_token", "")
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "PATCH", requrl, False
.setProxy 2, proxyuri
.SetRequestHeader "Content-Type", "application/json"
.SetRequestHeader "Prefer", "return=representation"
.SetRequestHeader "If-Match", etag
.SetRequestHeader "Authorization", "Bearer " & access_token
.send JsonConverter.ConvertToJson(JsonObject)
Debug.Print .Status
'返ってきた値をもとにデータを処理
Select Case .Status
Case 200
'レスポンスヘッダを取得
Debug.Print .getAllResponseHeaders()
'終了メッセージ
MsgBox "タスク更新が完了しました。"
Case Else
MsgBox "タスク更新に失敗しました"
End Select
End With
End Function
- タスクIDをもって、エンドポイントを構築します。
- @odata.etagの値が必要なのですが、形式が「W/"JzEtVCCCCCCCCCCCCCCCCCCCCCC="」といった様に、値にダブルコーテーションが含まれてしまってるので、直接入れるコードで記述する場合には、「etag = "W/""JzEtVCCCCCCCCCCCCCCCCCCCCCC="""」といった様に、ダブルコーテーションをエスケープする必要があります。
- 今回は、percentComplete（進捗状況）を50にすることで、処理中にするというリクエストを送っています。
- リクエストヘッダとして、「Prefer: return=representation」を追加が必須です
- リクエストヘッダとして、「If-Match:@odata.etagの値」を追加が必須です。
- リクエストはPATCHで行う点に注意が必要です
- 200が返ってきたら投稿成功です。
図：進行状況を変更してみた
リクエスト要求本文
新規追加時同様に、更新をする対象のplannerTaskの項目を要求本文に追加する事で、セットする事が可能です。taskidで指定してるので、planIdやbucketIdは必要ありません（変更する場合はセットする）。
{
"appliedCategories": {
"category3": true,
"category4": false
}
}
- 上記の事例は、ラベルを１個追加し、１個を剥がしてるリクエストになります。
タスクを削除する
通常削除するコード
タスクは完了とする場合は、前述の更新の手順でリクエスト本文にてpercentCompleteを100にする事で完了となります。しかし、この場合、Plannerには依然としてタスクは残り続けるので、一覧から消したい場合には、タスクの削除を実行する必要があります。
また、リクエストヘッダには、「If-Match:@odata.etagの値」の追加が必要になります。
この時に利用するAPIのエンドポイントは「https://graph.microsoft.com/beta/planner/tasks/ここにtaskidを入れる」となります（DELETEリクエスト）
Public Function deletetask()
'必要なデータを用意する
Dim taskid As String
Dim etag As String
Dim requrl As String
taskid = "ここにタスクIDを入れる"
etag = "ここに@odata.etagの値を入れる"
'リクエストURLを構築する
requrl = endpoint & "planner/tasks/" & taskid
'JSON受信用
Dim Json As Object
Dim resteams As Object
'Access Tokenの取得と失効チェック
Dim tokenstatus As Boolean
Dim ret As Variant
Dim access_token As String
tokenstatus = checkExpireToken() 'Access Tokenの取得と失効チェック
'Tokenの状況に応じて処理を分岐
Select Case tokenstatus
Case True
'無事にTokenは生きてるので何もしない
Case False
'refresh token使って新しいTokenを取得
ret = GetAccessToken(authcode, -1)
'取得結果を判定
If ret = True Then
'無事に取得できているのでスルーする
Else
'取得失敗
MsgBox "Access Tokenの取得に失敗しました。"
Exit Function
End If
End Select
'Access Tokenを取得する
access_token = IniRead("USER", "access_token", "")
'HTTPリクエスト
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "DELETE", requrl, False
'.setProxy 2, proxyuri
.SetRequestHeader "If-Match", etag
.SetRequestHeader "Authorization", "Bearer " & access_token
.send
'返ってきた値をもとにデータを処理
Select Case .Status
Case 204
'レスポンスヘッダを取得
Debug.Print .getAllResponseHeaders()
'終了メッセージ
MsgBox "タスク削除が完了しました。"
Case Else
MsgBox "タスク削除に失敗しました"
End Select
End With
End Function
- タスクIDをもって、エンドポイントを構築します。
- @odata.etagの値が必要なのですが、形式が「W/"JzEtVCCCCCCCCCCCCCCCCCCCCCC="」といった様に、値にダブルコーテーションが含まれてしまってるので、直接入れるコードで記述する場合には、「etag = "W/""JzEtVCCCCCCCCCCCCCCCCCCCCCC="""」といった様に、ダブルコーテーションをエスケープする必要があります。
- リクエストヘッダとして、「If-Match:@odata.etagの値」を追加が必須です。
- リクエストはDELETEで行う点に注意が必要です
- 204が返ってきたら投稿成功です。
- 成功時は特にResponseHeaderが無いので、空（{}）が返ってきます。
タスクに割り当てる
新規追加時やタスク更新時に、そのタスクに対して実行する人を割り当て（アサイン）する場合は、前述のタスクを更新すると殆ど同じコードを利用しますが、アサイン時のリクエスト要求本文が少々変則的なので、注意が必要です。また、割り当てる対象のメアドではなくMicrosoft365上のユーザのIDが必要になるので、予め取得しておく必要があります。
VBAのコード
'タスクを割り当てる
Public Function assigntask()
'エンドポイントURLを構築
Dim requrl As String
Dim taskid As String
taskid = "ここにタスクIDを入れる"
requrl = endpoint & "planner/tasks/" & taskid
'@odata.etagの値
Dim etag As String
etag = "ここに@odata.etagの値を入れる"
'アサインする対象者のMicrosoft365のid
Dim m365uid As String
m365uid = "対象ユーザのMicrosoft365上のID"
'JSON受信用
Dim Json As Object
Dim resteams As Object
'リクエストボディ
'リクエスト用のパラメータを構築
Dim JsonObject As Object
Dim uidObject As Object
Set JsonObject = New Dictionary
Set uidObject = New Dictionary
JsonObject.Add "assignments", New Dictionary 'assingmentsを作成
'ユーザIDに基づく項目を追加
uidObject.Add "@odata.type", "#microsoft.graph.plannerAssignment"
uidObject.Add "orderHint", " !"
'assignmentsにuidObjectを追加する
JsonObject("assignments").Add m365uid, uidObject
'Access Tokenの取得と失効チェック
Dim tokenstatus As Boolean
Dim ret As Variant
Dim access_token As String
tokenstatus = checkExpireToken() 'Access Tokenの取得と失効チェック
'Tokenの状況に応じて処理を分岐
Select Case tokenstatus
Case True
'無事にTokenは生きてるので何もしない
Case False
'refresh token使って新しいTokenを取得
ret = GetAccessToken(authcode, -1)
'取得結果を判定
If ret = True Then
'無事に取得できているのでスルーする
Else
'取得失敗
MsgBox "Access Tokenの取得に失敗しました。"
Exit Function
End If
End Select
'Access Tokenを取得する
access_token = IniRead("USER", "access_token", "")
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "PATCH", requrl, False
'.setProxy 2, proxyuri
.SetRequestHeader "Content-Type", "application/json"
.SetRequestHeader "Prefer", "return=representation"
.SetRequestHeader "If-Match", etag
.SetRequestHeader "Authorization", "Bearer " & access_token
.send JsonConverter.ConvertToJson(JsonObject)
'返ってきた値をもとにデータを処理
Select Case .Status
Case 200
'レスポンスヘッダを取得
Debug.Print .getAllResponseHeaders()
'終了メッセージ
MsgBox "タスク更新が完了しました。"
Case Else
MsgBox "タスク更新に失敗しました"
End Select
End With
End Function
- リクエスト本文の構築が少々厄介で、assignmentsをAddした後に、m365uidにてNew Dictionaryを追加してから、odata.typeやorderHintを追加しようとするとエラーになるので、別々にオブジェクトを用意してから、最後にassignmentsにuidOjbectを連結するようにしています。
- m365uidのオブジェクトに@odata.typeやorderHintを追加する
リクエスト要求本文
Microsoft365のユーザIDが要素の名称となっているので、やや作成方法が厄介です。
{
"assignmeents":{
"ユーザID":{
"@odata.type": "#microsoft.graph.plannerAssignment",
"orderHint" : " !"
}
}
}
409, 412エラーについて
Plannerのタスクを削除したり更新、タスク割当しようとした場合に、409もしくは412のエラーが返ってきて処理がキャンセルされる場合があります。これらはそれぞれ
- 409エラー : Conflict
- 412エラー：Precondition Failed。「The ETag value is too old, the item must be read again」というメッセージの表示がされる。
と呼ばれるエラーで、Plannerはその内容を更新したり、完了させたり、誰かにタスクを割り当てたりした場合、バージョン管理のために@odata.etagの値が変わってしまいます。そのため、これらの作業をした場合には予め取得してあるデータを差し替えておき、そのetagの値を持ってしてリクエストを行わないと、このエラーが出て削除が出来ない仕組みになっています。
一々変更した内容を記録したり、またアプリ外で更新された場合の事を考えると、このエラーは非常に厄介です。この場合の対処法ですが
- リクエストをして409, 412が返ってきたら条件を分岐
- タスクIDは変わらないので、バケット内のタスク一覧を取得するで行ったような単体でタスクIDを持って、再度現在のタスクの詳細情報を取得
- 改めて取得したタスクIDの中に新しい@odata.etagが入ってるはずなので、コレを取り出す。
- 取り出した@odata.etagを持ってして、再度削除や更新、タスク割当のリクエストを実行する
但しこれだと１タスクの削除に３回もリクエストを投げることになるので、初めからリクエストは最新のetag取得⇒リクエストの2回で行えば、大量に削除する場合は、結果的にリクエストコストを減らす事が可能です（本来は変更時に取得して差し替えておけば１回で済みますが、アプリ外で更新されると対処出来ない為。また起動時にバケットの情報を全部取ってくるのも量が多いと現実的ではないです。）
公式ドキュメントには詳細な内容が記載されていないので注意。
関連リンク
- Getting labels from Planner with Microsoft Graph API
- List tasks - Graph API
- Planner のタスクおよびプラン API の概要
- Microsoft Graph でタスクを登録してみる
- Microsoft Graphを使ってみた
- 【VBA】テーブルに値を追加する【Add、Copy、配列を使う】
- 【VBA】テーブル化された表の、レコード数を取得する
- VBAでparseしたJSONデータの要素を取得する方法
- EXCEL2013以降64BIT版で簡単URLエンコード EXCEL2013 Later URLEncode Function
- how two get key name using json object?
- Excel VBA Join関数 - Office TANAKA
- ダブルコーテーションのエスケープ - Office TANAKA
- Update Patch Microsoft Graph API Planner Task Detail using JSON cURL produces error 409 conflict
