2022年2月25日 / 最終更新日時 : 2024年1月12日 officeの杜 Microsoft365

VBAとMicrosoft Graph APIの連携 – Teams編

現在業務の自動化の為に、Electron, VBA, SAP GUI Scripting, Puppeteer等の他に「Microsoft Graph API」も非常に多く利用しています。決して使いやすいAPIではないのですが、認証の手段と大体の使い方を身に着けて、なるべくボタンひとつで業務が片付くように構築中です。

そんな中、以前Google Apps ScriptでGraph APIと連携してTeamsのログを取得するものを作成しましたが、今回Excel VBAで実装してみました。殆ど内容は同じですが、やはりローカルでデータを取得できるのは便利なので、Excel VBAはなかなか無くならないなと思います。

Google Apps ScriptとMicrosoft Graph APIの連携 – Teamsログ取得編

1 今回使用するファイル等
2 新方式が登場しました
3 事前準備
4 認証を実行する
- 4.1 ソースコード
  - 4.1.1 VBA側コード
  - 4.1.2 Node.js側コード
- 4.2 認証作業
5 シートに書き出しをする
- 5.1 ソースコード
- 5.2 レスポンスデータ
6 関連リンク

今回使用するファイル等

今回は、いつものIE11を使っての認証ではなく、以下のエントリーにあるようにPuppeteerを利用したOAuth2.0認証をするように変更しています。Node.jsにて作成し、EXEにパッケージ。これをVBAから叩いて利用しています。

Graph API認証用のEXEはサンプルファイルと同じディレクトリに入れておく必要があります。

VBAでOAuth2.0認証 - Windows11対応版

新方式が登場しました

IE11の廃止に伴い、SeleniumやNode.jsやらといった手段を使わず、またPuppeteerと同様の手法（CDPを叩く）でVBAとEdge/ChromeのみでOAuth2.0認証する手段が登場しました。スクレイピングも可能になっています。以下のエントリーを参考にしてみてください。この手法は最も制限が無く、もっともすぐれた選択肢になると思います。

VBAで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についてだけ定義している場合には、そのサーバーアドレスとポート番号を控えておく。

図：プロキシー設定がない場合はこの作業は不要です。

Azureでプロジェクトを作成

アプリの登録にて登録を開始する
新規登録をクリックする
名前を入力（今回はteamsgetterと入力しました）、リダイレクトURIは「webを選択」し、今回URLはこのサイトのURLを入力。http://localhostでも良いのですが、Chromeを利用するので、自社のウェブサイトなどのURLを利用しましょう。
登録ボタンをクリックする
出てきた中で、「アプリケーション（クラと書かれているのがクライアントID」なので、このコードをメモしておく
左サイドバーより、「証明書とシークレット」をクリック
「新しいクライアントシークレット」をクリックする
今回は特に有効期限を設けないで追加をクリック
これで「値」に「クライアントシークレット」が生成されて手に入りました。このシークレットはこの時だけしか表示されないので、注意してください（IDは不要なのでメモらなくていいです）
つづけて、左サイドバーより「APIのアクセス許可」をクリックする
Microsoft APIの中にある「Microsoft Graph」をクリックする。
「委任されたアクセス許可」をクリックする
デフォルトでUser.ReadがすでにONなので、今回はopenid, offline_access、Group.Read.All、User.Read.All、Group.ReadWrite.All、ChannelMessage.Read.Allを検索してONにしましょう（今回のスコープは赤字のものが、管理者の承認がどうしても必要になります）
アクセス許可の追加をクリックする
追加出来たら、xxxxxに管理者の同意を与えますをクリックします。すると、状態が緑色になります。今回は管理者の権限を要求するものは無いのでしなくても大丈夫だと思う
次に左サイドバーより「認証」をクリック
暗黙の付与にて、「アクセストークン」にチェックを入れる
サポートされているアカウントの種類に於いては、「マルチテナント」にしておきました。
保存をクリック
概要のエンドポイントをクリックすると、いろいろなエンドポイントURLが出る。
概要のディレクトリ（テナントの数値はメモっておきます。あとでプログラム中で使用します。
デフォルトでは組織アカウントでなければOAuth2.0認証が出来ません。

※3.でWebを選ばないSPAを選んでしまうと、Proof Key for Code Exchange by OAuth Public Clientsといったエラーが出てしまい認証ができませんので注意。

図：アプリの登録から全ては始まります。

図：Graphを選択する

図：アクセス権限付与した状態

図：認証の設定変更に注意

Teamsのログ取得に必要な情報を集める

Teamsのログ取得に必要な情報を集めなければなりません。集めた情報でGraph Explorerを使い実際に取得できるのかどうかをテストする事が可能です。

Graph Explorerに行き、ログインしておく
サンプルクエリにてteamsで検索。Beta内にあるチャネル内のメッセージをクリックする
取得するURLは、https://graph.microsoft.com/beta/teams/{group-id-for-teams}/channels/{channel-id}/messagesといったようなスタイル
グループIDがチームのIDとなります。チームを開きこのチームへのリンクを取得でリンクをまず取得します。
4.にgroupIdが入ってるので、そのIDを取得します。
次にチャネルIDが必要です。対象のチャネルを開きます。
URLを見てみると、threadId以下に数字2桁:半角英数文字列～@thread.tacv2の文字があります。これがチャネルIDとなるので控えておきます。
チームのIDをgroup-id-for-teamsに入れ、チャネルIDをchannel-idに入れる。
組み立てたURLを入れてクエリ実行をする
まだこの段階では取れていません。ここでアクセス許可の修正をクリック
出てきたアクセス一覧の全ての同意をクリックする。この時、onmicrosoft.comアカウントではない場合、ChannelMessage.Read.Allの同意が出来ない事があります。
無事に取得できると、OK – 200が返ってきて対象のチャネル内の全メッセージが取得出来ます。
ちなみに、なんとなくわかると思いますが、JSONの中のbodyがメッセージ本文、reactionsの中のreactionTypeがいいねに該当します。displayNameが投稿した人の名前ですね。

図：求められたアクセス許可

図：認証が通ると全メッセージがJSONで取得される

調べたデータを追記する

ExcelのVBA開発画面を開き、標準モジュールのauth3の項目内にある変数に、ここまでに調べた各種値を追記します。

tenant - テナントIDを記述する
client_id - クライアントIDを記述する
client_secret - クライアントシークレットを記述する
redirecturl - リダイレクトURLを記述する
groupId - TeamsのグループIDを記述する
channelId - TeamsのチャンネルIDを記述する
proxyuri - プロキシーのURLを記述する（使わない場合には、コード内の.setProxy 2, proxyuriの行はコメントアウトが必要）

scopeなどは設定いる内容のまま弄る必要はありません。

認証を実行する

冒頭にあるように、いつものようにIE11で認証を実行してAccess Tokenを取得するのではなく、Windows11 64bitを見据えて、今回はNode.js + Puppeteer + pkgにてWindows用のEXEを作っており、VBAから叩いてAuthcodeを取得する所まではそちらで対応しています。故に、要Chrome or Microsoft Edgeです。

ソースコード

VBA側コード

'Graph 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
    Debug.Print sCmd
    
    Set wExec = WSH.Exec("%ComSpec% /c " & sCmd)
    
    'ステータスを見てループ
    Do While wExec.Status = 0
        DoEvents
    Loop
    
    '標準出力内容を取得
    authcode = wExec.StdOut.ReadAll
    
    '取得したコードからcode=以下を取得する
    Dim tokenget As Boolean
    tokenget = GetAccessToken(authcode, 0)
    
    '取得結果を表示
    If tokenget = True Then
      MsgBox "認証が完了しました。"
    Else
      MsgBox "認証に失敗しました。"
    End If
 
    '終了処理
    Set wExec = Nothing
    Set WSH = Nothing
    
End Function

'Graph 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

Debug.Print sCmd

Set wExec = WSH.Exec("%ComSpec% /c " & sCmd)

'ステータスを見てループ

Do While wExec.Status = 0

DoEvents

Loop

'標準出力内容を取得

authcode = wExec.StdOut.ReadAll

'取得したコードからcode=以下を取得する

Dim tokenget As Boolean

tokenget = GetAccessToken(authcode, 0)

'取得結果を表示

If tokenget = True Then

MsgBox "認証が完了しました。"

Else

MsgBox "認証に失敗しました。"

End If

'終了処理

Set wExec = Nothing

Set WSH = Nothing

End Function

Authenticate Codeを取得するまでのコードです。
Node.jsで作られてるexeに対して、引数で認証用URLを渡し、相手側のプログラムが完了するまで待機させてあります
scopeにはAzure側で利用するスコープ名を半角スペースで区切りますが、半角スペースは%20として指定しています
&で引数を区切り渡すと壊れるので、こちらも%26として置き換えて指定（相手側のプログラムでこれは&に変換させています）
出力を受け取ったら、今回はDebug.Printで表示していますが、次の「Access Token」を取得するプログラムへ渡します
Access Token取得および、Refresh Tokenで再取得、Expireの状態チェックのコードはここでは省略します。

Node.js側コード

今回は、command-line-argsおよびpuppeteer-coreを利用して、VBAからのコマンドライン引数で認証用URLを取得し、PuppeteerでMicrosoft Graph APIの認証⇒Authenticate Codeの取得までを担当させています。それ以降はVBA単体で行えます。また、過去の以下のエントリをベースに作っていますが、OAuth2.0認証だとちょっとコードが足らないので、追加しています。

Puppeteerで途中でユーザに入力してもらうようにする

//使用するモジュール
const puppeteer = require('puppeteer-core');
var fs = require('fs');
const path = require("path");
var shell = require('child_process').exec;
var spawnSync = require('child_process').spawnSync;
const commandLineArgs = require('command-line-args');
 
//edge/chromeのパスを取得（ユーザ権限インストール時）
const userHome = process.env[process.platform == "win32" ? "USERPROFILE" : "HOME"];
var kiteipath = "C:\\Program Files (x86)\\Google\\Chrome\\Application\\chrome.exe";
var temppath = path.join(userHome, "AppData\\Local\\Google\\Chrome\\Application\\chrome.exe");
var edgepath = "C:\\Program Files (x86)\\Microsoft\\Edge\\Application\\msedge.exe";
 
//chrome場所判定
if (fs.existsSync(kiteipath)) {
	chromepath = kiteipath
} else {
	if (fs.existsSync(temppath)) {
	  chromepath = temppath;
	} else {
	  //Chromium Edgeの場合に対応
	  if(fs.existsSync(edgepath)){
		  chromepath = edgepath;
	  }else{
		  //IEを起動してChromeのインストールを促す　　　
		  shellexec('start "" "iexplore" "https://www.google.co.jp/chrome/"')
		  return;
	  }
	}
}
 
//コマンドライン引数を取得
const optionDefinitions = [
	{
	  name: 'geturl',
	  alias: 'g',
	  type: String
	}
];
const args = commandLineArgs(optionDefinitions);
 
//puppeteer実行
main();
 
//puppeteerメイン関数
async function main() {
	const browser = await puppeteer.launch({
		headless: false,
		executablePath: chromepath,
		ignoreDefaultArgs: ["--guest",'--disable-extensions','--start-fullscreen','--incognito',],
		slowMo:100,
	});
	
	//引数からURLを取得する
	var tempurl = args.geturl;

	//redirecturlを取得する
	var redirect = tempurl.substr(tempurl.indexOf('redirect_uri=') + 13);

	//%26を&に変換する
	var url = tempurl.replace(/%26/g, "&");

	//pageを定義
	const page = await browser.newPage()
	const navigationPromise = page.waitForNavigation()
 
	//ログインページを開く
	const response = await page.goto(url)
	await page.setViewport({ width: 1300, height: 900 })
	await navigationPromise
	
	//特定要素が出てくるまでウェイト(タイムアウトは90秒を指定）
	await page.waitForSelector('#idBtn_Back',{timeout:90000})
	
	//パスワード画面だけはユーザに入力させる
	var result_input = await waitEvent(page);
	await navigationPromise
	
	//現在のURLを取得
	var allPages = await browser.pages();
	var ret = allPages[1].url();
	await navigationPromise
	
	//リダイレクトURLが含まれているかチェックし、含まれるまでループ(二段階認証対応)
	var rcheck = ret.indexOf(redirect);
	
	while(rcheck == -1){
		//再度、URLを取得
		allPages = await browser.pages();
		ret = allPages[1].url();
		
		//リダイレクトURLが含まれているかチェックし、含まれるまでループ
		rcheck = ret.indexOf(redirect);
		
		//rcheckが-1の場合はウェイトを入れる
		if(rcheck == -1){
			await page.waitForNavigation('networkidle2');
		}
	}
	
	//code=以降の文字列を取得する
	var cutman = ret.substr(ret.indexOf('code=') + 5);
	cutarr = cutman.split("&");

	//Authenticate Codeを出力する
	console.log(cutarr[0]);
	
	//ブラウザを閉じる
	await browser.close()
}

//入力イベント待ちをする関数
async function waitEvent(page){
  return new Promise(async resolve=>{
      //chromeに一時的な関数を作って送り込む（funcmanという名前にしました）
      //何度も使い回す場合は、event名を重複しないようにする必要があります。
      await page.exposeFunction("funcman",()=>{
        //result_inputへ値を返す
        resolve("ログインできた");
      });
      
      //ボタンにクリックすると一時的な関数を実行するイベントを割り当てるコードを実行
      await page.evaluate(()=>{
          document.getElementById("idSIButton9").addEventListener("click",()=>{
            //ダミーのイベント
            eval('window.funcman();');
          });
      });
  });
}

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

//使用するモジュール

const puppeteer = require('puppeteer-core');

var fs = require('fs');

const path = require("path");

var shell = require('child_process').exec;

var spawnSync = require('child_process').spawnSync;

const commandLineArgs = require('command-line-args');

//edge/chromeのパスを取得（ユーザ権限インストール時）

const userHome = process.env[process.platform == "win32" ? "USERPROFILE" : "HOME"];

var kiteipath = "C:\\Program Files (x86)\\Google\\Chrome\\Application\\chrome.exe";

var temppath = path.join(userHome, "AppData\\Local\\Google\\Chrome\\Application\\chrome.exe");

var edgepath = "C:\\Program Files (x86)\\Microsoft\\Edge\\Application\\msedge.exe";

//chrome場所判定

if (fs.existsSync(kiteipath)) {

chromepath = kiteipath

} else {

if (fs.existsSync(temppath)) {

chromepath = temppath;

} else {

//Chromium Edgeの場合に対応

if(fs.existsSync(edgepath)){

chromepath = edgepath;

}else{

//IEを起動してChromeのインストールを促す　　　

shellexec('start "" "iexplore" "https://www.google.co.jp/chrome/"')

return;

}

//コマンドライン引数を取得

const optionDefinitions = [

{

name: 'geturl',

alias: 'g',

type: String

}

];

const args = commandLineArgs(optionDefinitions);

//puppeteer実行

main();

//puppeteerメイン関数

async function main() {

const browser = await puppeteer.launch({

headless: false,

executablePath: chromepath,

ignoreDefaultArgs: ["--guest",'--disable-extensions','--start-fullscreen','--incognito',],

slowMo:100,

});

//引数からURLを取得する

var tempurl = args.geturl;

//redirecturlを取得する

var redirect = tempurl.substr(tempurl.indexOf('redirect_uri=') + 13);

//%26を&に変換する

var url = tempurl.replace(/%26/g, "&");

//pageを定義

const page = await browser.newPage()

const navigationPromise = page.waitForNavigation()

//ログインページを開く

const response = await page.goto(url)

await page.setViewport({ width: 1300, height: 900 })

await navigationPromise

//特定要素が出てくるまでウェイト(タイムアウトは90秒を指定）

await page.waitForSelector('#idBtn_Back',{timeout:90000})

//パスワード画面だけはユーザに入力させる

var result_input = await waitEvent(page);

await navigationPromise

//現在のURLを取得

var allPages = await browser.pages();

var ret = allPages[1].url();

await navigationPromise

//リダイレクトURLが含まれているかチェックし、含まれるまでループ(二段階認証対応)

var rcheck = ret.indexOf(redirect);

while(rcheck == -1){

//再度、URLを取得

allPages = await browser.pages();

ret = allPages[1].url();

//リダイレクトURLが含まれているかチェックし、含まれるまでループ

rcheck = ret.indexOf(redirect);

//rcheckが-1の場合はウェイトを入れる

if(rcheck == -1){

await page.waitForNavigation('networkidle2');

}

//code=以降の文字列を取得する

var cutman = ret.substr(ret.indexOf('code=') + 5);

cutarr = cutman.split("&");

//Authenticate Codeを出力する

console.log(cutarr[0]);

//ブラウザを閉じる

await browser.close()

}

//入力イベント待ちをする関数

async function waitEvent(page){

return new Promise(async resolve=>{

//chromeに一時的な関数を作って送り込む（funcmanという名前にしました）

//何度も使い回す場合は、event名を重複しないようにする必要があります。

await page.exposeFunction("funcman",()=>{

//result_inputへ値を返す

resolve("ログインできた");

});

//ボタンにクリックすると一時的な関数を実行するイベントを割り当てるコードを実行

await page.evaluate(()=>{

document.getElementById("idSIButton9").addEventListener("click",()=>{

//ダミーのイベント

eval('window.funcman();');

});

}

index-win -g 認証用URLの引数でこのプログラムに渡してあげます
受け取った引数のうち、%26の文字は「&」に変換します。理由はそのままVBA側から&で渡すと引数が壊れる為。
ログイン後の「ログインしたままにするか？」の画面の「いいえ」のボタン（#idBtn_Back）が表示されるまでウェイトを掛けています。
上記ボタンのwaitForSelectorの引数timeout:90000を入れてるのは、デフォルト値だと入力などの時間が足らずに、タイムアウトしやすい為（0だとタイムアウト無しになる）
ユーザがID、パスを入力し、サインインを維持したままにするか？にて「はい」をクリックすると、waitEvent関数が発動し、リダイレクトURL先に飛ぶまで待機させています（故にnetworkidle2のwaitForNavigationも入れている）
成功するとリダイレクト先のURLにcode=でAuthenticate Codeが付与されている。このURLは2個目のタブにあるURLなので、allPages[1].url()で取得させています。response.request().redirectChain()などでは取れないので、要注意（responseの中にはそれっぽいURLがいるのだけれど）
code=以降のauthenticate code以外にも、stateやら何やら入ってるので、まずはcode=以降を取得、次に&で区切って配列にし、1個目の値がソレになるので取り出す
取り出したら、console.logで出力するとVBA側で拾ってくれる
初回認証時のURLにはclient_idは入っているが、client_secretは使われていない。
二段階認証対応のウェイトを入れています。

あとは、VBAの側でこのAuthenticate Codeを引き換えにAccess TokenやRefresh Tokenを取得する仕組みに投げて上げれば良い。上記のコードでpkgやnexeを使ってビルドする事で、単体の認証用のEXEが出来上がります（そちらの方法はこちらのエントリーを参考にしてください）

認証作業

ここまでで、OAuth2.0認証のAuthenticate Codeの取得までが装備出来ているので、VBA側で「GraphAuthorization」を実行します。まだ、今回の装備ではAccess Tokenなどは取得出来ていないので、Graph APIを叩ける状態にないのですが、次回の実装編ではこれまでのエントリー同様に、Access Tokenの取得、Tokenのリフレッシュ、Excel Onlineの読み書きを実装します。

実行すると

用意しておいた認証用URLをindex-win.exeに引き渡す
Puppeteerにてインストール済みのChromeもしくはChromium Edgeが起動し認証ページが開かれる
ログイン作業をして、「サインインを維持したままにするか？」では「はい」をクリックする
二段階認証をセットしてる場合は、3.の前にスマフォアプリのAuthenticatorなどによる認証作業が間に入ります。
リダイレクトURL先にcode=付きのURLで飛ばされて、Authenticate Codeを取り出す

という作業が行われます。

※今回のコードでは、Access TokenやRefresh Tokenなどがsetting.iniに平文で書き出されますので、暗号化復号化などの処理を追加実装して、セキュリティ的に高める必要があります。

図：サインインは維持する

シートに書き出しをする

事前準備を終えて、認証を実行完了すれば、後はボタンひとつで、対象のチャンネル内のレスを取得することができます。仕様上、親スレッドを先に取得してからリプライを取得して１つの塊としていますので、１つのエントリーで２回HTTPリクエストが必要です。

また、レスポンスデータはJSONなので、JsonConverterで分解しながら配列に格納し、Sheet1に一気に書き出しています。

ソースコード

'テーブルデータを取得する
Public Function getTeamsLogs()
    'エンドポイントURLを構築
    Dim requrl As String
    requrl = endpoint & "teams/" & groupId & "/channels/" & channelId & "/messages"

    '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")
    Dim tomato
    
    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("createdDateTime")             '作成日
                    recarr(counter, 2) = records("subject")                     'タイトル
                    recarr(counter, 3) = records("from")("user")("id")          'ユーザID
                    recarr(counter, 4) = records("from")("user")("displayName") 'ユーザ名
                    recarr(counter, 5) = records("body")("content")             '本文
                    recarr(counter, 6) = records("webUrl")                      'メッセージURL
                    recarr(counter, 7) = records("reactions").Count             'リアクション数

                    'カウンタを加算
                    counter = counter + 1
                    
                    'メッセージIDを元にリプライを取得
                    msgid = records("id")
                    teamschild = requrl & "/" & msgid & "/replies/"
                    
                    'トークンステータスチェック
                    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", teamschild, 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 resteams = JsonConverter.ParseJson(tomato)
                            
                            'レコード数を調べる
                            totalcnt = totalcnt + resteams("value").Count

                            'resteamsの中身を取り出す
                            For Each rep In resteams("value")
                                'リプライを取得して配列に追加
                                recarr(counter, 0) = rep("id")                          'メッセージID
                                recarr(counter, 1) = rep("createdDateTime")             '作成日
                                recarr(counter, 2) = records("subject")                 'タイトル
                                recarr(counter, 3) = rep("from")("user")("id")          'ユーザID
                                recarr(counter, 4) = rep("from")("user")("displayName") 'ユーザ名
                                recarr(counter, 5) = rep("body")("content")             '本文
                                recarr(counter, 6) = rep("webUrl")                      'メッセージURL
                                recarr(counter, 7) = rep("reactions").Count             'リアクション数
                        
                                'カウンタを加算
                                counter = counter + 1
                            Next
                        Case Else
                            'エラーを返す
                            MsgBox "リプライレコードの取得に失敗しました"
                            Exit Function
                    End Select
                Next
                
                '配列を縮める
                '一時的な配列を用意する
                Dim tempArray()
                
                'Transpose関数を使って配列に突っ込む
                tempArray = WorksheetFunction.Transpose(recarr)
                
                'ReDimで配列の要素数を再定義
                ReDim Preserve tempArray(1 To UBound(tempArray, 1), 1 To totalcnt + 1)
                
                '元に戻す
                recarr = WorksheetFunction.Transpose(tempArray)
                
                '書き込みレコード数
                Dim editrec As Integer
                editrec = totalcnt + 2
                
                '配列をシートに書き出し
                ThisWorkbook.Worksheets("Sheet1").Range("A2:H" & editrec) = recarr
                
                '終了メッセージ
                MsgBox "データの取得が完了しました。"
                

            Case Else
                MsgBox "レコードの取得に失敗しました"
        End Select
    End With

End Function

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

'テーブルデータを取得する

Public Function getTeamsLogs()

'エンドポイントURLを構築

Dim requrl As String

requrl = endpoint & "teams/" & groupId & "/channels/" & channelId & "/messages"

'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")

Dim tomato

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("createdDateTime") '作成日

recarr(counter, 2) = records("subject") 'タイトル

recarr(counter, 3) = records("from")("user")("id") 'ユーザID

recarr(counter, 4) = records("from")("user")("displayName") 'ユーザ名

recarr(counter, 5) = records("body")("content") '本文

recarr(counter, 6) = records("webUrl") 'メッセージURL

recarr(counter, 7) = records("reactions").Count 'リアクション数

'カウンタを加算

counter = counter + 1

'メッセージIDを元にリプライを取得

msgid = records("id")

teamschild = requrl & "/" & msgid & "/replies/"

'トークンステータスチェック

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", teamschild, 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 resteams = JsonConverter.ParseJson(tomato)

'レコード数を調べる

totalcnt = totalcnt + resteams("value").Count

'resteamsの中身を取り出す

For Each rep In resteams("value")

'リプライを取得して配列に追加

recarr(counter, 0) = rep("id") 'メッセージID

recarr(counter, 1) = rep("createdDateTime") '作成日

recarr(counter, 2) = records("subject") 'タイトル

recarr(counter, 3) = rep("from")("user")("id") 'ユーザID

recarr(counter, 4) = rep("from")("user")("displayName") 'ユーザ名

recarr(counter, 5) = rep("body")("content") '本文

recarr(counter, 6) = rep("webUrl") 'メッセージURL

recarr(counter, 7) = rep("reactions").Count 'リアクション数

'カウンタを加算

counter = counter + 1

Case Else

'エラーを返す

MsgBox "リプライレコードの取得に失敗しました"

Exit Function

End Select

'配列を縮める

'一時的な配列を用意する

Dim tempArray()

'Transpose関数を使って配列に突っ込む

tempArray = WorksheetFunction.Transpose(recarr)

'ReDimで配列の要素数を再定義

ReDim Preserve tempArray(1 To UBound(tempArray, 1), 1 To totalcnt + 1)

'元に戻す

recarr = WorksheetFunction.Transpose(tempArray)

'書き込みレコード数

Dim editrec As Integer

editrec = totalcnt + 2

'配列をシートに書き出し

ThisWorkbook.Worksheets("Sheet1").Range("A2:H" & editrec) = recarr

'終了メッセージ

MsgBox "データの取得が完了しました。"

Case Else

MsgBox "レコードの取得に失敗しました"

End Select

End With

End Function

親スレッドのデータを取得し、メッセージIDを取得します。
そのメッセージIDを元に再度、Graph APIにてリプライデータを取得するURLを構築してリクエストをします。
リプライデータまで含めた変数を最後シートに塊で書き出しています。
今回は先に配列で10000レコード分を用意し、最後に実際のレコード数に戻す為にRedim Preserveしていますが、Transpose関数で行列逆転してから行う必要があるので、上記のような処理を追加しています（Redimでは列は増やせても行は増やせない為）

レスポンスデータ

{
    "@odata.context": "https://graph.microsoft.com/beta/$metadata#teams('xxxxx')/channels('xxxxx')/messages",
    "@odata.count": ここにレスの件数,
    "value": [
        {
            "id": "1645761796881",
            "replyToId": null,
            "etag": "1645761796881",
            "messageType": "message",
            "createdDateTime": "ここに作成日",
            "lastModifiedDateTime": "ここに更新日",
            "lastEditedDateTime": null,
            "deletedDateTime": null,
            "subject": "Mr.Children",
            "summary": null,
            "chatId": null,
            "importance": "normal",
            "locale": "en-us",
            "webUrl": "ここにリプライへの直リンクURL",
            "onBehalfOf": null,
            "policyViolation": null,
            "eventDetail": null,
            "from": {
                "application": null,
                "device": null,
                "user": {
                    "id": "Azure上のユーザ固有のID",
                    "displayName": "投稿者の氏名",
                    "userIdentityType": "aadUser"
                }
            },
            "body": {
                "contentType": "text",
                "content": "ここに投稿本文が入ります"
            },
            "channelIdentity": {
                "teamId": "xxxxxxx",
                "channelId": "xxxxxx"
            },
            "attachments": [],
            "mentions": [],
            "reactions": [
                {
                    "reactionType": "リアクションのタイプ",
                    "createdDateTime": "リアクション日付",
                    "user": {
                        "application": null,
                        "device": null,
                        "user": {
                            "id": "リアクションした人のID",
                            "displayName": null,
                            "userIdentityType": "aadUser"
                        }
                    }
                }
            ]
        }
    ]
}

{

"@odata.context": "https://graph.microsoft.com/beta/$metadata#teams('xxxxx')/channels('xxxxx')/messages",

"@odata.count": ここにレスの件数,

"value": [

{

"id": "1645761796881",

"replyToId": null,

"etag": "1645761796881",

"messageType": "message",

"createdDateTime": "ここに作成日",

"lastModifiedDateTime": "ここに更新日",

"lastEditedDateTime": null,

"deletedDateTime": null,

"subject": "Mr.Children",

"summary": null,

"chatId": null,

"importance": "normal",

"locale": "en-us",

"webUrl": "ここにリプライへの直リンクURL",

"onBehalfOf": null,

"policyViolation": null,

"eventDetail": null,

"from": {

"application": null,

"device": null,

"user": {

"id": "Azure上のユーザ固有のID",

"displayName": "投稿者の氏名",

"userIdentityType": "aadUser"

}

"body": {

"contentType": "text",

"content": "ここに投稿本文が入ります"

"channelIdentity": {

"teamId": "xxxxxxx",

"channelId": "xxxxxx"

"attachments": [],

"mentions": [],

"reactions": [

{

"reactionType": "リアクションのタイプ",

"createdDateTime": "リアクション日付",

"user": {

"application": null,

"device": null,

"user": {

"id": "リアクションした人のID",

"displayName": null,

"userIdentityType": "aadUser"

}

]

}

]

}

reactionが、イイネなどのアクションに該当します。今回は件数しか利用していません
reactionType別にカウントして、イイネを貰った回数などを集計したい場合に便利です。

VBAとMicrosoft Graph APIの連携 – Teams編

今回使用するファイル等

新方式が登場しました

事前準備

プロキシー設定を調べる

Azureでプロジェクトを作成

Teamsのログ取得に必要な情報を集める

調べたデータを追記する

認証を実行する

ソースコード

VBA側コード

Node.js側コード

認証作業

シートに書き出しをする

ソースコード

レスポンスデータ

関連リンク

コメントを残すコメントをキャンセル

Chrome OS Flexで古いPCを蘇らせる

M1 MacやiOSでも動く高機能な仮想環境UTMを使ってみた

今回使用するファイル等

新方式が登場しました

事前準備

プロキシー設定を調べる

Azureでプロジェクトを作成

Teamsのログ取得に必要な情報を集める

調べたデータを追記する

認証を実行する

ソースコード

VBA側コード

Node.js側コード

認証作業

シートに書き出しをする

ソースコード

レスポンスデータ

関連リンク

コメントを残す コメントをキャンセル

Chrome OS Flexで古いPCを蘇らせる

M1 MacやiOSでも動く高機能な仮想環境UTMを使ってみた

コメントを残すコメントをキャンセル