Private
Sub
Application_ItemSend(
ByVal
Item
As
Object
, Cancel
As
Boolean
)
Dim
xYesNo
As
Integer
Dim
xPrompt
As
String
Dim
xTaskItem
As
TaskItem
Dim
xRecipient
As
String
On
Error
Resume
Next
xPrompt =
"Do you want to create a task for this message?"
xYesNo = MsgBox(xPrompt, vbYesNo + vbInformation,
"Kutools for Outlook"
)
Cancel =
False
If
xYesNo = vbNo
Then
Exit
Sub
Set
xTaskItem = Application.CreateItem(olTaskItem)
For
Each
Rcp
In
Item.Recipients
If
xRecipient =
""
Then
xRecipient = Rcp.Address
Else
xRecipient = xRecipient & vbCrLf & Rcp.Address
End
If
Next
Rcp
xRecipient = xRecipient & vbCrLf & Item.Body
With
xTaskItem
.Subject = Item.Subject
.StartDate = Item.ReceivedTime
.DueDate =
Date
+ 3 +
CDate
(
"9:00:00 AM"
)
.ReminderSet =
True
.ReminderTime =
Date
+ 2 +
CDate
(
"9:00:00 AM"
)
.Body = xRecipient
.Save
End
With
Set
xTaskItem =
Nothing
End
Sub