Excel VBA 逆引き集 | 実務テンプレ完全版（超再利用部品） – 自動配信ツール（Teams）

Excel VBA
スポンサーリンク

ねらい：Excelの一覧から、Teamsに「自動でメッセージ投稿」する“型”を作る

メールと同じで、Teams も「毎日・毎週・毎月、同じような通知」を流すなら、自動化した方が圧倒的に楽です。
Excel に「どのチャンネルに、どんなメッセージを、どのタイミングで送るか」を一覧で持ち、VBA で Teams に投げる“テンプレート”を作っておくと、通知業務が一気に整理されていきます。

ここでは、プログラミング初心者向けに、

  • Teams 側の準備（Incoming Webhook の URL）
  • Excel シート設計（誰に、何を）
  • VBA から Webhook に JSON を投げるコード
  • 日次・月次処理と組み合わせた運用例

までを、かみ砕いて説明します。

Teams 側の準備：Incoming Webhook を作って URL を手に入れる

Incoming Webhook のイメージ

Excel VBA から直接 Teams に話しかけるわけではありません。
正確には「Teams のチャンネルにぶら下がった Webhook URL（窓口）に、Excel から HTTP でメッセージを投げる」イメージです。

やることは 1 つだけです。

  1. Teams の投稿先チャンネルで、Incoming Webhook を追加して URL を取得する。

細かい画面操作はここでは省きますが、最終的にこんな URL が 1 本手に入ります。

https://outlook.office.com/webhook/xxxxx/IncomingWebhook/yyyyy/zzzzz

この URL を Excel のシートに貼っておき、VBA から「そこにメッセージを投げる」だけです。

シート設計：誰に・何を・いつ送るかを Excel に書いておく

MailList と同じ発想で TeamsList を作る

まずは「TeamsList」という名前のシートを 1 枚作ります。
最低限、次のような列を用意します。

A列: SendFlag（送信対象かどうか。Y/N）
B列: WebhookUrl（投稿先 Teams チャンネルの Incoming Webhook URL）
C列: Title（カードのタイトル）
D列: MessageTemplate（メッセージ本文テンプレート）
E列: Level（通知レベル：Info / Warning / Error など、絵文字や色分け用）
F列: Extra1（差し込み用1：例えば日付や件名）
G列: Extra2（差し込み用2：例えば数値やURL）

MessageTemplate には、こんな感じのプレースホルダ入りテキストを入れておきます。

{Extra1} のバッチ処理が完了しました。

対象レコード数：{Extra2} 件

詳細はレポートをご確認ください。

あとで VBA で {Extra1} や {Extra2} を置き換えます。

共通基盤：HTTP POST とテンプレ差し込みのユーティリティ

HTTP POST（Webhook に JSON を投げる）共通関数

Teams の Incoming Webhook は、JSON 形式のテキストを HTTP POST で受け取ります。
VBA からは XMLHTTP（または WinHTTP）を使って POST します。

' ModTeams_Base.bas
Option Explicit

Public Function HttpPostJson(ByVal url As String, ByVal jsonBody As String) As Boolean
    On Error GoTo ErrHandler
    
    Dim xhr As Object
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    
    xhr.Open "POST", url, False
    xhr.setRequestHeader "Content-Type", "application/json"
    xhr.send jsonBody
    
    If xhr.Status >= 200 And xhr.Status < 300 Then
        HttpPostJson = True
    Else
        HttpPostJson = False
    End If
    
    Exit Function
ErrHandler:
    HttpPostJson = False
End Function
VB

ここでは「成功かどうか」を True/False で返すだけのシンプルな設計にしています。
本格的には、レスポンス本文やステータスコードをログに残すなどを追加できます。

メッセージテンプレートの差し込み

メールのときと同じ発想で、 {Key} を置き換える小さな関数を用意します。

' ModTeams_Template.bas
Option Explicit

Public Function ApplyPlaceholder(ByVal template As String, ByVal key As String, ByVal value As String) As String
    ApplyPlaceholder = Replace(template, "{" & key & "}", value)
End Function

Public Function BuildMessage(ByVal template As String, _
                             ByVal extra1 As String, _
                             ByVal extra2 As String) As String
    Dim msg As String
    msg = template
    msg = ApplyPlaceholder(msg, "Extra1", extra1)
    msg = ApplyPlaceholder(msg, "Extra2", extra2)
    BuildMessage = msg
End Function
VB

差し込みたい項目が増えたら、BuildMessage の中を増やすだけで対応できます。

Teams 向け JSON（メッセージカード）の組み立て

最小構成の JSON（テキストメッセージだけ）

Incoming Webhook は、シンプルなケースなら以下のような JSON だけで投稿できます。

{
  "text": "こんにちは、これは Excel VBA から投稿されたメッセージです。"
}

VBA 側で、Title や MessageTemplate、Level を使ってこの JSON を組み立てます。

' ModTeams_Payload.bas
Option Explicit

Public Function BuildTeamsJson(ByVal title As String, _
                               ByVal body As String, _
                               ByVal level As String) As String
    Dim emoji As String
    Select Case LCase$(level)
        Case "warning"
            emoji = "⚠️"
        Case "error"
            emoji = "❌"
        Case Else
            emoji = "ℹ️"
    End Select
    
    Dim text As String
    text = emoji & " " & title & vbCrLf & vbCrLf & body
    
    ' JSON の特殊文字（" や改行）を簡易エスケープする
    Dim jsonText As String
    jsonText = Replace(text, """", "\""")   ' " → \"
    jsonText = Replace(jsonText, vbCrLf, "\n")
    
    BuildTeamsJson = "{""text"":""" & jsonText & """}"
End Function
VB

重要なのは、JSON 内に入れるテキストの中で " や改行をそのまま使わないことです。
ここでは最低限、

  • " を \" に置換
  • 改行を \n に置換

しています。

一括配信ロジック：TeamsList の各行からメッセージを投稿する

TeamsList をループして Webhook に POST する

' ModTeams_Bulk.bas
Option Explicit

Public Sub BulkPost_ToTeams()
    Dim ws As Worksheet
    Set ws = Worksheets("TeamsList")
    
    Dim a As Variant
    a = ws.Range("A1").CurrentRegion.Value
    
    Dim r As Long
    Dim total As Long, success As Long, failed As Long
    total = 0: success = 0: failed = 0
    
    For r = 2 To UBound(a, 1)
        Dim flag As String
        flag = UCase$(Trim$(CStr(a(r, 1)))) ' SendFlag
        
        If flag = "Y" Then
            total = total + 1
            
            Dim url As String
            Dim title As String
            Dim tmpl As String
            Dim level As String
            Dim extra1 As String
            Dim extra2 As String
            
            url = Trim$(CStr(a(r, 2)))
            title = CStr(a(r, 3))
            tmpl = CStr(a(r, 4))
            level = CStr(a(r, 5))
            extra1 = CStr(a(r, 6))
            extra2 = CStr(a(r, 7))
            
            If Len(url) = 0 Then
                ws.Cells(r, 8).Value = "URLなし"
                failed = failed + 1
                GoTo NextRow
            End If
            
            Dim msg As String
            msg = BuildMessage(tmpl, extra1, extra2)
            
            Dim json As String
            json = BuildTeamsJson(title, msg, level)
            
            Dim ok As Boolean
            ok = HttpPostJson(url, json)
            
            If ok Then
                ws.Cells(r, 8).Value = "OK"
                success = success + 1
            Else
                ws.Cells(r, 8).Value = "NG"
                failed = failed + 1
            End If
            
            ws.Cells(r, 9).Value = Now ' 実行時刻をログ
        End If
NextRow:
    Next r
    
    MsgBox "Teams自動投稿が完了しました。" & vbCrLf & _
           "対象: " & total & " 行" & vbCrLf & _
           "成功: " & success & ", 失敗: " & failed, _
           vbInformation
End Sub
VB

ここでのポイントを整理します。

SendFlag が Y の行だけを処理します。
これにより、「今回はこの行だけ送る／送らない」という制御が簡単にできます。

結果と時刻を右側の列（ここでは H列:結果、I列:日時）にログとして書いています。
後から「この通知は送れたのか／失敗したのか」を一目で確認できます。

Webhook URL が空の場合はその行を飛ばし、結果に「URLなし」と記録します。
ここを見て、Teams の設定漏れがないかを確認できます。

例題：日次売上サマリを Teams へ自動投稿する流れ

想定シナリオ

  • 別のマクロ（日次処理）で「今日の売上合計」と「件数」を集計し、Excel のどこかに値が入っている
  • Teams の特定チャンネル（例えば “日次報告”）に、毎朝そのサマリを投稿したい

この場合、以下のように組み合わせます。

  1. 日次処理マクロで、売上合計と件数をセルに出す
  2. その値を使って TeamsList の Extra1, Extra2 を埋める
  3. BulkPost_ToTeams を呼び出す

サンプルコードの流れ

' ModTeams_Example.bas
Option Explicit

Public Sub Run_DailySales_ToTeams()
    ' 1) 日次売上集計（ここではダミーでセルから読むとする）
    Dim salesTotal As Double
    Dim salesCount As Long
    
    salesTotal = Worksheets("Summary").Range("B2").Value   ' 今日の売上合計
    salesCount = Worksheets("Summary").Range("B3").Value   ' 今日の件数
    
    ' 2) TeamsList の1行目（2行目のレコード）に差し込む値をセット
    Dim ws As Worksheet
    Set ws = Worksheets("TeamsList")
    
    ws.Range("A2").Value = "Y"                              ' SendFlag
    ' B2: WebhookUrl はあらかじめ設定済みとして
    ws.Range("C2").Value = "本日の売上サマリ"
    ws.Range("D2").Value = "{Extra1} の売上サマリです。" & vbCrLf & _
                           "合計売上：{Extra2} 円" & vbCrLf & _
                           "件数：" & salesCount & " 件"
    ws.Range("E2").Value = "Info"
    ws.Range("F2").Value = Format(Date, "yyyy-mm-dd")       ' Extra1 = 日付
    ws.Range("G2").Value = Format(salesTotal, "#,##0")      ' Extra2 = 金額（文字列として）
    
    ' 3) Teams に投稿
    BulkPost_ToTeams
End Sub
VB

このイメージで運用すると、

  • 日次バッチ（売上集計）
  • Teams連携（自動投稿）

を一気に「ボタン1発」で回せます。

重要ポイントの深掘り：Teams 自動投稿を“安全に”回すために

Webhook URL の管理をどうするか

Webhook URL は、漏れると不正な投稿のリスクが出ます。
そのため、以下のような運用をおすすめします。

TeamsList シートを別ブックに分け、そこにだけ Webhook URL を書く。
そのブックは共有範囲を絞る（パスワードや権限）。
VBA からは、そのブックを参照して URL を読み込むだけにする。

少なくとも、「誰でも見れる共有ブックに Webhook URL をベタ書き」は避けると安心です。

テストチャンネルを必ず用意する

いきなり本番の Teams チャンネルに投稿するのではなく、

  • 専用の“テスト用チャンネル”を作る
  • そこに向けた Webhook URL で動作確認する

というステップを踏むと安心です。
投稿内容や整形の具合をテストチャンネルで確認してから、本番の URL に差し替えましょう。

メッセージの長さ・構造は“最小限”から始める

最初から複雑なカード（セクション・ボタン付き）にしようとすると、
JSONの構造やトラブルシュートが一気に難しくなります。

まずは {"text":"…"} のシンプルな投稿で始めて、

  • 絵文字
  • 改行
  • 色（レベルごとの絵文字・テキスト）

ぐらいまで慣れてから、Adaptive Card などに拡張する、というステップをおすすめします。

失敗した投稿をどう扱うか

HttpPostJson は True/False を返しています。
False（失敗）の場合、TeamsList シートの結果列に「NG」と書いています。

この情報を使って、

  • 再実行対象だけ SendFlag を Y に戻す
  • 失敗理由（URLミス・ネットワーク・Webhook無効）を調査する

といった運用がやりやすくなります。
可能なら「ErrorDetail」列をもう1つ追加し、ステータスコードやエラーメッセージを書き込むように拡張するとさらに便利です。

まとめ：Excel で“誰に何を通知するか”を管理し、VBA で Teams に投げる

自動配信ツール（Teams）は、

Teams 側：Incoming Webhook を作って URL を用意する。
Excel 側：TeamsList に「SendFlag, WebhookUrl, Title, MessageTemplate, Extra…」を書いておく。
VBA 側：テンプレ差し込み → JSON 組み立て → HttpPostJson で一括送信。

という形にしておけば、

日次・週次・月次のバッチ結果
エラー検知・アラート
レポート生成完了通知

などを、チームが一番見ている場所（Teams チャンネル）に、自動で流し込めます。

スポンサーリンク
タイトルとURLをコピーしました