Creating a Task from Email and Attaching Original Email

Status
Not open for further replies.

llravlin

Member
Outlook version
Email Account
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!
 
You can.
olTask.Attachments.Add Item

As an FYI, you can use
With olTask
.Subject = "Follow Up : " & item.To & " : About : " & item.Subject
.body = "whatever"
.Attachments.Add Item
.duedate = now =+5
'any other fields
.save
End with
 
Task.png attachment.png
You can.
olTask.Attachments.Add Item

As an FYI, you can use
With olTask
.Subject = "Follow Up : " & item.To & " : About : " & item.Subject
.body = "whatever"
.Attachments.Add Item
.duedate = now =+5
'any other fields
.save
End with

I did what you suggested, but the task attaches "untitled" twice and only the To: information, nothing else...

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.Attachments.Add item
With olTask
.Subject = "Follow Up : " & item.To & " : About : " & item.Subject
.Body = olTask.Body & "Sent : " & Date & " " & Time & vbCrLf
.Body = olTask.Body & "To : " & item.To & vbCrLf
.Body = olTask.Body & "Subject : " & item.Subject & vbCrLf
.Body = olTask.Body & "Body : " & item.Body & vbCrLf
'olTask.ContactNames = Item.To
.Categories = "FOLLOW UP"
'MsgBox (Item.To)
.StartDate = Date
.DueDate = Date + numDays
.Status = olTaskWaiting
'Set the reminder for 3 hours from now
.ReminderSet = True
.ReminderTime = DateAdd("d", numDays, Now)
.Attachments.Add item
.Display
.Save
End With
End If
End If
End Sub

The task and attachments look like this:
 
You're adding it twice - once as
olTask.Attachments.Add item

and again in the With olTasks
.Attachments.Add item

I was going to say the attachments weren't working here, but then i remembered i was testing with an outlook.com account, and it doesn't support attachments. :)

In an account that supports attachments, it looks like the attachment is blank. Instead of grabbing it as its sent, I'd try grabbing it as its added to the sent folder (using ItemAdd instead of ItemSend). It might work to get the message's entryid and find it using it. (Entryid did not work - its not created until its added to the sent folder)
 
This is my version - i removed the annoying dialogs but you can put it back in. :) :)

Code:
Option Explicit 
Private WithEvents item As Outlook.Items 
 
Private Sub Application_Startup() 
  Dim Ns As Outlook.NameSpace 
  Set Ns = Application.GetNamespace("MAPI") 
  Set item = Ns.GetDefaultFolder(olFolderSentMail).Items 
End Sub 
 
Private Sub Application_ItemSend(ByVal item As Object, cancel As Boolean) 
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 
End If 
End Sub 
 
Private Sub item_ItemAdd(ByVal item As Object) 
Dim olTask As Outlook.TaskItem 
Dim olItem As Object 
Dim numdays 
 
If MsgBox("Create A Follow Up Task?", vbYesNo) = vbYes Then 
  numdays = 3 'InputBox(prompt:=uPrompt, Default:=3) 
 
Set olTask = Application.CreateItem(olTaskItem) 
With olTask 
  .Subject = "Follow Up : " & item.To & " : About : " & item.Subject 
  .Body = .Body & vbCrLf & " Sent : " & Date & " " & Time & vbCrLf 
  .Body = .Body & vbCrLf & " To : " & item.To & vbCrLf 
  .Body = .Body & vbCrLf & " Subject : " & item.Subject & vbCrLf 
  .Body = .Body & vbCrLf & " Body : " & item.Body & vbCrLf 
  .Categories = "FOLLOW UP" 
  .StartDate = Date 
  .DueDate = Date + numdays 
  .Status = olTaskWaiting 
  .ReminderSet = True 
  .ReminderTime = DateAdd("d", numdays, Now) 
  .Attachments.Add item 
  .Display 
  .Save 
End With 
End If 
End Sub
 
Thank you for this new set of code...

Right before you sent this, I tried one last thing with what I originally had and it worked...

I put and item.Save before the rest of the code which saved it as draft...then the code, save again and it worked...

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
item.Save
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)
With olTask
.Attachments.Add item
.Subject = "Follow Up : " & item.To & " : About : " & item.Subject
.Body = olTask.Body & "Sent : " & Date & " " & Time & vbCrLf
.Body = olTask.Body & "To : " & item.To & vbCrLf
.Body = olTask.Body & "Subject : " & item.Subject & vbCrLf
.Body = olTask.Body & "Body : " & item.Body & vbCrLf
'olTask.ContactNames = Item.To
.Categories = "FOLLOW UP"
'MsgBox (Item.To)
.StartDate = Date
.DueDate = Date + numDays
.Status = olTaskWaiting
'Set the reminder for 3 hours from now
.ReminderSet = True
.ReminderTime = DateAdd("d", numDays, Now)
.Display
.Save
End With
End If
End If
End Sub
 
It's probably the better option - less code is always better IMHO. :)
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
G Event when creating task from mailitem Outlook VBA and Custom Forms 2
Wotme Creating a Outlook task in Excel Using Outlook 7
J Text color when creating a new Task is not consistent Using Outlook 1
B Creating a new TASK using VFP9.0 Outlook VBA and Custom Forms 2
T Creating Task Views Methodically Outlook VBA and Custom Forms 7
Y Creating a Task with VBScript Outlook VBA and Custom Forms 14
G Creating Macro to scrape emails from calendar invite body Outlook VBA and Custom Forms 6
S Custom Contact card - need help creating one Outlook VBA and Custom Forms 1
D Outlook 2016 Creating an outlook Macro to select and approve Outlook VBA and Custom Forms 0
N Help creating a VBA macro with conditional formatting to change the font color of all external emails to red Outlook VBA and Custom Forms 5
T Outlook creating unwanted tasks in Tasks and Todo from emails Using Outlook 1
Fozzie Bear Outlook 2016 Creating a shared local Contacts folder Using Outlook 2
R Creating a user defined function Outlook VBA and Custom Forms 3
M Creating an RSS Feed **FROM** Outlook 2013 Calendar. Using Outlook 5
O How to prevent CC from showing when creating a new mail? Using Outlook 1
N Creating a button or link to a form in the Organizational Forms Library Outlook VBA and Custom Forms 3
B Creating an email with the list of tasks Outlook VBA and Custom Forms 0
L Creating drafts when I thought I was sending Using Outlook 1
R Would creating a new profile cause Outlook to download all the old mails from the server? Using Outlook 1
A Creating Progress Bar or Status Bar Update Outlook VBA and Custom Forms 0
T Outlook creating a folder named: "Unwanted" Using Outlook 3
M Outlook 2007 Contacts Glitch: Creating a new email Using Outlook 1
Liza Creating a rule in outlook to filter messages Using Outlook 0
A Are categories still recommended for creating local distribution lists? Using Outlook 3
S Creating Email - Selecting Pre-Defined Text Using Outlook 2
D Creating an outlook session from Access vba but run silently. With A specific profile Outlook VBA and Custom Forms 1
M Creating Outlook Appointments from Excel Cells Outlook VBA and Custom Forms 1
N Creating New Profile Using Outlook 0
Y Creating custom appointment request form with multiple mail recipients Outlook VBA and Custom Forms 5
M creating email from contact file = 3 emails in To field Using Outlook 3
P Recover / Extract Rules from standalone PST file creating RWZ file Using Outlook 2
A Creating an outlook rule to forward an email with a specific message Using Outlook 1
I Creating meeting invite with disabled tentative button Outlook VBA and Custom Forms 5
E Creating email templates for organizational use Using Outlook 0
N Creating or changing the main new mail message template in Outlook 2010 Using Outlook 2
D Creating custom view with VBA Outlook VBA and Custom Forms 2
J Outlook creating unwanted rule on its own Using Outlook 1
R Creating a Room Mailbox with Exchange Online Outlook VBA and Custom Forms 0
A Creating a rule on “Deleted items” folder Using Outlook 1
CMG73 Creating templates with predefined subject and CC Using Outlook 1
G Creating Contact Sub Folders Using Outlook 2
Rupert Dragwater creating gmail account in Outlook 2013 Using Outlook 7
nathandavies Creating a Select Case for a directory of folders Outlook VBA and Custom Forms 1
2 creating custom stationery Using Outlook 2
A Help creating macro for conditional formatting settings Using Outlook 8
Fozzie Bear Creating Custom Meeting Form Outlook VBA and Custom Forms 6
U Creating a (This computer only) folder within an IMAP account directory Using Outlook 1
A Creating archive rule on the clients by script/ Outlook VBA and Custom Forms 3
J Creating a URL from a message body excerpt before forwarding Using Outlook 2
B Need Help Creating Email Based on Subject w Address in Body Outlook VBA and Custom Forms 1

Similar threads

Back
Top