ToDo完了後に毎回リスト更新、メール送信――VBAでその手順、削減しませんか？：働く価値を上げる“VBA／GAS”術（13）（2/4 ページ）

[高橋宣成，プランノーツ]

ToDo完了メール送信マクロ

　ToDoシートのステータスを「完了」に変更した際に動作するイベントプロシージャ「Sub Worksheet_Change(ByVal Target As Range)」を以下に記載します。なお、このプロシージャは標準モジュールではなく、シートモジュールに記載します。詳細は後述しますが、注意してください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Range
Set myRange = Sheet1.ListObjects(1).ListColumns("ステータス").DataBodyRange
Dim r As Range
For Each r In Target
    If Not Intersect(myRange, r) Is Nothing And r.Value = "完了" Then
        Call ToDo完了メール送信(r.row)
    End If
Next r
End Sub

　このプロシージャは、Sheet1でセルの値の変更があった際に自動で動作します。その際の処理の流れは以下になります。

1. 変数myRangeにステータス欄の範囲を設定
2. 変更されたセル範囲の各セルについて繰り返し
   ┗対象のセルがステータス欄の範囲に含まれており、かつその値が「完了」であれば
   　┗Subプロシージャ「ToDo完了メール送信(ByVal row As Long)」を呼び出す

　また、イベントプロシージャ「Sub Worksheet_Change(ByVal Target As Range)」内で呼び出している「Sub ToDo完了メール送信(ByVal row As Long)」およびその中で使用している列挙体「e」の宣言については、以下の通り標準モジュールに記載します。

Public Enum e
    no = 1
    記入日
    タスク
    期限
    ステータス
End Enum
Sub ToDo完了メール送信(ByVal row As Long)
    
'各要素の作成
With Sheet1
    Dim myNo As Long: myNo = .Cells(row, e.no).Value
    Dim myTask As String: myTask = .Cells(row, e.タスク).Value
End With
Const MY_TO As String = "[e-mail]"
Const RECIPIENT As String = "皆様"
Dim mySubject As String
mySubject = mySubject & "タスク完了メール: [" & myNo & "] " & myTask
Dim myBody As String: myBody = ""
myBody = myBody & RECIPIENT & "<br>"
myBody = myBody & "以下のタスクが完了しました<br>"
myBody = myBody & "[" & myNo & "] " & myTask
'メールの送信
Dim olApp As Outlook.Application: Set olApp = New Outlook.Application
Dim myMail As MailItem: Set myMail = olApp.CreateItem(olMailItem)
With myMail
    .To = MY_TO
    .Subject = mySubject
    .Display
    .HTMLBody = myBody & .HTMLBody
    .Send
End With
End Sub

　このプロシージャの大まかな処理の流れは以下になります。

1. 変更があった行のデータからNo、タスクを取得
2. メールの送信先アドレス、件名、本文を文字列として生成
3. 「Outlook.Application」オブジェクトの生成
4. メールの作成および送信

　Outlook.Applicationの操作、メールの作成は第11回、テーブルの操作や列挙体については第9回で紹介しているので、併せてご確認ください。