G
guiness_joe
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
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