Excelでの集計処理や日次バッチが終わったタイミングで、担当者のTeamsチャンネルへ自動で通知が飛んだら便利だと思いませんか。ExcelVBAからWebhook URLへHTTPリクエストを送るだけで、Outlookを開かずにTeamsへメッセージを届けることができます。
この記事では、VBAのWinHTTPを使ってTeamsへメッセージを自動送信する方法を、JSONペイロードの組み立て方から送信結果の確認まで解説します。
Webhook URLを準備する
TeamsへVBAから通知を送るには、まずメッセージの送信先となる「Webhook URL」が必要です。以前は「Incoming Webhookコネクタ」から発行していましたが、このコネクタ機能はMicrosoftによって段階的に廃止されており、現在は通知先チャンネルでPower Automateの「ワークフロー」(Teams向けの「Webhook要求を受信したとき」トリガーを使ったフロー)を作成し、そこで発行されるHTTP POST用URLを利用する形が主流になっています。
発行されたURLには認証情報が含まれる機密情報なので、コードに直接埋め込まず、設定シートや環境変数から読み込むようにしてください。
Function GetTeamsWebhookUrl() As String
' 実際の運用では、設定シートやiniファイルから読み込む想定
GetTeamsWebhookUrl = ThisWorkbook.Worksheets("Config").Range("B1").Value
End Function
VBAからJSONを送信する基本コード
WinHTTPオブジェクトを使い、JSON形式の本文をPOSTで送信します。
Sub SendTeamsNotification(message As String)
Dim http As Object
Dim webhookUrl As String
Dim jsonBody As String
webhookUrl = GetTeamsWebhookUrl()
jsonBody = "{""text"": """ & EscapeJson(message) & """}"
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
On Error GoTo ErrHandler
With http
.Open "POST", webhookUrl, False
.SetRequestHeader "Content-Type", "application/json"
.Send jsonBody
End With
If http.Status = 200 Or http.Status = 202 Then
Debug.Print "Teams通知を送信しました"
Else
Debug.Print "送信失敗: ステータス " & http.Status & " " & http.StatusText
End If
Exit Sub
ErrHandler:
Debug.Print "通信エラー: " & Err.Number & " " & Err.Description
End Sub
Openの第3引数をFalseにすることで同期送信になり、送信完了までコードの実行が待機しますSetRequestHeaderでContent-Typeをapplication/jsonに指定しないと、Teams側でメッセージとして認識されませんhttp.StatusでHTTPステータスコードを確認し、200番台以外なら送信失敗として扱います
JSON文字列を安全に組み立てる
メッセージ本文にダブルクォートや改行が含まれると、JSONの形式が崩れてエラーになります。送信前に必ずエスケープ処理を行いましょう。
Function EscapeJson(text As String) As String
Dim result As String
result = text
result = Replace(result, "\", "\\")
result = Replace(result, """", "\""")
result = Replace(result, vbCrLf, "\n")
result = Replace(result, vbLf, "\n")
EscapeJson = result
End Function
バックスラッシュを最初に置換してから、ダブルクォートと改行を置換する順番がポイントです。順番を逆にすると、エスケープ文字自体が二重に置換されてしまいます。
処理完了通知として組み込む例
日次のデータ集計マクロの末尾に組み込み、処理結果をそのままTeamsへ通知する例です。
Sub RunDailySummaryAndNotify()
Dim processedCount As Long
processedCount = RunDailySummary()
SendTeamsNotification "日次集計が完了しました。処理件数: " & processedCount & "件(" & Format(Now, "yyyy/mm/dd hh:nn") & ")"
End Sub
RunDailySummaryは集計処理を行い、処理件数をLong型で返す想定の自作関数です。処理が終わるたびに件数と日時をメッセージに含めることで、実行結果を離れた場所からでも確認できます。
よくあるエラーと対処法
- ステータス400が返る:JSON文字列の形式が崩れている場合に多く発生します。メッセージ内にエスケープしていないダブルクォートが含まれていないか確認してください
- ステータス403・404が返る:Webhook URLの有効期限切れ、またはワークフロー側が削除・無効化されている可能性があります。Teams側でワークフローの状態を確認してください
- 送信自体が固まる(応答が返ってこない):
.Openの第3引数をTrue(非同期)にしている場合に起こりがちです。同期送信のFalseを使うか、非同期の場合はwaitForResponse処理を別途実装してください
まとめ
WinHTTPを使ってJSONペイロードをPOSTするだけで、ExcelVBAからTeamsチャンネルへ直接通知を送信できます。
- Webhook URLはPower Automateのワークフロー機能で発行し、コードに直書きせず設定シートなどから読み込む
- JSON本文はダブルクォート・改行・バックスラッシュのエスケープ処理を忘れずに行う
http.Statusで送信結果を確認し、失敗時はエラー内容をログに残せるようにしておく
日次バッチや長時間処理の完了通知として組み込んでおけば、処理状況をリアルタイムで把握できるようになります。


コメント