Hi,
I have a macro in the ThisOutlookSession in Outlook to ask if I want to create a task and if Yes, creates it. It works great, but can I attach the orginal sent email to the task in case I need to reply to that original email?
Here is the code I have working:
Private Sub Application_ItemSend(ByVal item As Object, cancel As Boolean)
Dim olApp As Outlook.Application
Dim olTask As Outlook.TaskItem
Dim olItem As Object
'Dim olMessage As Outlook.MailItem
'olMessage.To
If TypeOf item Is Outlook.MailItem Then
If item.Subject = "" Then
If MsgBox("This message has no subject, are you sure you want to send it?", vbYesNo + vbQuestion, "Confirm") = vbNo Then
cancel = True
End If
End If
If MsgBox("Create A Follow Up Task?", vbYesNo) = vbYes Then
uPrompt = "Follow-up how many days from now?"
numDays = InputBox(prompt:=uPrompt, Default:=3)
Set olApp = Application
Set olTask = olApp.CreateItem(olTaskItem)
olTask.Subject = "Follow Up : " & item.To & " : About : " & item.Subject
olTask.Body = olTask.Body & "Sent : " & Date & " " & Time & vbCrLf
olTask.Body = olTask.Body & "To : " & item.To & vbCrLf
olTask.Body = olTask.Body & "Subject : " & item.Subject & vbCrLf
olTask.Body = olTask.Body & "Body : " & item.Body & vbCrLf
'olTask.ContactNames = Item.To
olTask.Categories = "FOLLOW UP"
'MsgBox (Item.To)
olTask.StartDate = Date
olTask.DueDate = Date + numDays
olTask.Status = olTaskWaiting
'Set the reminder for 3 hours from now
olTask.ReminderSet = True
olTask.ReminderTime = DateAdd("d", numDays, Now)
olTask.Display
olTask.Save
End If
End If
End Sub
Any help is appreciated...
Thanks!
I have a macro in the ThisOutlookSession in Outlook to ask if I want to create a task and if Yes, creates it. It works great, but can I attach the orginal sent email to the task in case I need to reply to that original email?
Here is the code I have working:
Private Sub Application_ItemSend(ByVal item As Object, cancel As Boolean)
Dim olApp As Outlook.Application
Dim olTask As Outlook.TaskItem
Dim olItem As Object
'Dim olMessage As Outlook.MailItem
'olMessage.To
If TypeOf item Is Outlook.MailItem Then
If item.Subject = "" Then
If MsgBox("This message has no subject, are you sure you want to send it?", vbYesNo + vbQuestion, "Confirm") = vbNo Then
cancel = True
End If
End If
If MsgBox("Create A Follow Up Task?", vbYesNo) = vbYes Then
uPrompt = "Follow-up how many days from now?"
numDays = InputBox(prompt:=uPrompt, Default:=3)
Set olApp = Application
Set olTask = olApp.CreateItem(olTaskItem)
olTask.Subject = "Follow Up : " & item.To & " : About : " & item.Subject
olTask.Body = olTask.Body & "Sent : " & Date & " " & Time & vbCrLf
olTask.Body = olTask.Body & "To : " & item.To & vbCrLf
olTask.Body = olTask.Body & "Subject : " & item.Subject & vbCrLf
olTask.Body = olTask.Body & "Body : " & item.Body & vbCrLf
'olTask.ContactNames = Item.To
olTask.Categories = "FOLLOW UP"
'MsgBox (Item.To)
olTask.StartDate = Date
olTask.DueDate = Date + numDays
olTask.Status = olTaskWaiting
'Set the reminder for 3 hours from now
olTask.ReminderSet = True
olTask.ReminderTime = DateAdd("d", numDays, Now)
olTask.Display
olTask.Save
End If
End If
End Sub
Any help is appreciated...
Thanks!