依頼メール送付時に自動でタスクに追加するコード

このマクロはメール送信イベントをトリガーとして、件名が【依頼】から始まっていたら、自動的に回答フォロー作業をタスク登録する、というマクロです。

自動とは言っても、フォロー日はダイヤログでの記入式です。
入力画面でキャンセルすると、タスク登録はされません。
入力値が日付以外もタスク登録はしないようにしました。（メールは送信されます）

それがこちらのコードです。コピペで動くと思います。


Private Sub Application_ItemSend(ByVal objItem As Object, boolCancel As Boolean)

    If Left(objItem.Subject, 4) = "【依頼】" Then
        Call 依頼回収フォロー作業をタスク登録(objItem)
    End If

End Sub


Private Sub 依頼回収フォロー作業をタスク登録(ByVal objItem As Object)
 'ダイヤログボックスを表示し、回答フォロー日を入力させる
    Dim strName As String
    strName = InputBox("回答フォロー日を設定ください。YYYY/MM/DD" & vbLf & _
                        "キャンセルするとタスクに登録しません。", _
                        "依頼フォロータスク登録", _
                        Left(Date + 3, 10))
    If StrPtr(strName) = 0 Then Exit Sub 'キャンセル時にマクロ終了
    
    '日付データでなければタスク登録はキャンセルする
    If IsDate(strName) = False Then
        MsgBox "日付データではないため、タスク登録をキャンセルします。（メールは送られます）"
        Exit Sub
    End If

 'タスク登録作業
    Dim objTaskItem As TaskItem
    Set objTaskItem = CreateItem(olTaskItem)

    With objTaskItem
        .Subject = "回答フォロー" & objItem.Subject 'タスク件名設定
        .StartDate = strName                        'タスク日
        .ReminderSet = True                         'リマインダセット
        If .ReminderSet = True Then                 'リマインダ日もタスク日とする
            .ReminderTime = strName
        End If
        
    'いつのメールのことか本文にメモっておく
        .Body = objItem.ReceivedTime & "に送付したメールの回答フォロー"

    'タスクに登録する
        .Save
    End With

End Sub

このマクロは、メール送信イベントに関するマクロなので、標準モジュールではなく↓ここに入れてください。