Tasks - convert email to task & attach email

Please find below code which converts email into a task, and pastes the email
text body into the task body and also pastes the email as attachment.

Problem:

1) the attached email is pasted at the end of the task body. I want it to be
pasted at the beginning of the task followed by the task body.
2) Can the task be automatically be saved into a personal folder?
3) Is there a way to autotype the categories list by typing the first few
letters?
4) Is there a way to auto fill calendar with the task items?

Public Sub AddCalendarEntry()
Const mailItem_c As String = "MailItem"
Dim OE As Outlook.Explorer ' olExp
Dim MI As Outlook.MailItem
Dim AI As Outlook.AppointmentItem
Dim TI As Outlook.TaskItem ' olTask
Dim olItem As Object

Set OE = Application.ActiveExplorer

'Abort sub if no item selected:
If OE.Selection.Count < 1 Then
MsgBox "Please select an already saved message before" & vbCrLf & _
"attempting to create an appointment or task" & vbCrLf & _
"with this button ...", vbInformation, "No message selected ..."
Exit Sub
'Abort sub if item selected is not a MailItem.
ElseIf TypeName(OE.Selection(1)) <> mailItem_c Then
MsgBox "You must select a mail item...", vbInformation, "Invalid
selection..."
Exit Sub
End If

Set MI = OE.Selection(1)
Beep
Select Case MsgBox("Is calendar entry an appointment?" & vbLf & _
"To Add Appointment (Yes) / To Add Task (No) / To Quit (Cancel)" & _
vbCrLf, vbYesNoCancel + vbQuestion, "Create an appointment or task
....")
Case vbYes 'If yes, create appointment
Set AI = Outlook.CreateItem(olAppointmentItem)
With AI
.Subject = MI.Subject

.Body = MI.Body
.Save
.Display
End With
Case vbNo
'If no, create task due with date of today
'and due date is tomorrow at 10:00 am

Set TI = Application.CreateItem(olTaskItem)

With TI

Dim cntSelection As Integer
cntSelection = OE.Selection.Count

For i = 1 To cntSelection

Set olItem = OE.Selection.Item(i)
TI.Attachments.Add olItem

Next

.Subject = MI.Subject
.Body = MI.Body
' .StartDate = Date
' .DueDate = Date + 1
' .ReminderTime = .DueDate & " 10:00"
.Save
.Display

End With

'Case vbCancel
' Exit Sub
End Select
End Sub

1) Outlook version?

2) Do you mean that you want to create a task in a folder other than your
default Tasks folder?

3) No.

4) Please explain what you mean by that.

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"guiness_joe" <guiness_joe DeleteThis @discussions.microsoft.com> wrote in message
news:11BE8E23-486D-424E-922A-545A4BA15AFF@microsoft.com...
> Please find below code which converts email into a task, and pastes the
> email
> text body into the task body and also pastes the email as attachment.
>
> Problem:
>
> 1) the attached email is pasted at the end of the task body. I want it to
> be
> pasted at the beginning of the task followed by the task body.
> 2) Can the task be automatically be saved into a personal folder?
> 3) Is there a way to autotype the categories list by typing the first few
> letters?
> 4) Is there a way to auto fill calendar with the task items?
>
> Public Sub AddCalendarEntry()
> Const mailItem_c As String = "MailItem"
> Dim OE As Outlook.Explorer ' olExp
> Dim MI As Outlook.MailItem
> Dim AI As Outlook.AppointmentItem
> Dim TI As Outlook.TaskItem ' olTask
> Dim olItem As Object
>
> Set OE = Application.ActiveExplorer
>
> 'Abort sub if no item selected:
> If OE.Selection.Count < 1 Then
> MsgBox "Please select an already saved message before" & vbCrLf & _
> "attempting to create an appointment or task" & vbCrLf & _
> "with this button ...", vbInformation, "No message selected ..."
> Exit Sub
> 'Abort sub if item selected is not a MailItem.
> ElseIf TypeName(OE.Selection(1)) <> mailItem_c Then
> MsgBox "You must select a mail item...", vbInformation, "Invalid
> selection..."
> Exit Sub
> End If
>
> Set MI = OE.Selection(1)
> Beep
> Select Case MsgBox("Is calendar entry an appointment?" & vbLf & _
> "To Add Appointment (Yes) / To Add Task (No) / To Quit (Cancel)" &
> _
> vbCrLf, vbYesNoCancel + vbQuestion, "Create an appointment or task
> ...")
> Case vbYes 'If yes, create appointment
> Set AI = Outlook.CreateItem(olAppointmentItem)
> With AI
> .Subject = MI.Subject
>
> .Body = MI.Body
> .Save
> .Display
> End With
> Case vbNo
> 'If no, create task due with date of today
> 'and due date is tomorrow at 10:00 am
>
> Set TI = Application.CreateItem(olTaskItem)
>
> With TI
>
> Dim cntSelection As Integer
> cntSelection = OE.Selection.Count
>
> For i = 1 To cntSelection
>
> Set olItem = OE.Selection.Item(i)
> TI.Attachments.Add olItem
>
> Next
>
> .Subject = MI.Subject
> .Body = MI.Body
> ' .StartDate = Date
> ' .DueDate = Date + 1
> ' .ReminderTime = .DueDate & " 10:00"
> .Save
> .Display
>
> End With
>
> 'Case vbCancel
> ' Exit Sub
> End Select
> End Sub