"Sue Mosher [MVP]" wrote:

1) Outlook version? 2003

2) Do you mean that you want to create a task in a folder other than your
default Tasks folder? Yes, the below task after being created saves into a Personal folder.

3) No.

4) Please explain what you mean by that.
Can appointments be made of the Incomplete Task items that exist in the task
folder?

--
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" wrote in message
...
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