【ExcelVBA・マクロ】Microsoft Teamsへ自動通知する方法|Incoming WebhookでVBAからメッセージを送信する【コピペOK】

ExcelVBA

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にすることで同期送信になり、送信完了までコードの実行が待機します
  • SetRequestHeaderContent-Typeapplication/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で送信結果を確認し、失敗時はエラー内容をログに残せるようにしておく

日次バッチや長時間処理の完了通知として組み込んでおけば、処理状況をリアルタイムで把握できるようになります。

スポンサーリンク
スポンサーリンク
ExcelVBA
シェアする
いがぴをフォローする

コメント

タイトルとURLをコピーしました