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

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

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 = "[email protected]"
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