View Single Post
  #4  
Old August 26th 08, 05:55 AM posted to microsoft.public.outlook.program_vba
TheBase
external usenet poster
 
Posts: 1
Default Email to Task, move task to 'Other Tasks' folder to sync w/Sharepo

the following code contains two Subs,
Assign sub will:
- create the task
- add the email entry ID as a property to the task (as a reference)
- Attach the email to the task.
- Flag the orignal e-mail and add "Assigned task" to the top

Complete sub will:
- clear the flag from the email when the task is completed.

hope this will help... here is the code

Sub Assign()
'Get a reference to the MAPI namespace
Dim objNS As Outlook.NameSpace
Set objNS = Application.GetNamespace("MAPI")

' Get a reference to the currently selected Outlook folder
Dim currentFolder As Outlook.MAPIFolder
Set currentFolder = Application.ActiveExplorer.currentFolder


' Make sure at least one item is selected
If Application.ActiveExplorer Is Nothing Then
MsgBox "Please select an item"
Exit Sub
End If
If Application.ActiveExplorer.Selection Is Nothing Then
MsgBox "Please select an item"
Exit Sub
End If

'Get Selected Item
Dim oItem As Outlook.MailItem
Set oItem = Application.ActiveExplorer.Selection(1)

'Flag E-mail
oItem.FlagIcon = olBlueFlagIcon
oItem.FlagStatus = olFlagMarked
oItem.FlagRequest = "Assinged task on " & Now()

'Create a new task
Dim oTask As Outlook.TaskItem
Set oTask = Application.CreateItem(olTaskItem)

'Map task to e-mail using Email entry ID
Dim oProp As Outlook.UserProperty
Set oProp = oTask.UserProperties.Add("EmailEntryID", olText, True)
oProp.Value = oItem.EntryID

'Assing task properties
oTask.Subject = oItem.Subject
oTask.StartDate = Now()
oTask.Status = olTaskNotStarted
oTask.Attachments.Add oItem, olByValue
oTask.Assign

'open task
oTask.Display

'clear objects from the memory
Set objNS = Nothing
Set currentFolder = Nothing
Set oItem = Nothing
Set oTask = Nothing
Set oProp = Nothing
Set ojbAtt = Nothing
End Sub

Sub Complete()
On Error GoTo e
'Get a reference to the MAPI namespace
Dim objNS As Outlook.NameSpace
Set objNS = Application.GetNamespace("MAPI")
' Get a reference to the currently selected Outlook folder
Dim currentFolder As Outlook.MAPIFolder
Set currentFolder = Application.ActiveExplorer.currentFolder
'Get current task
Dim oSels As Outlook.Selection
Set oSels = Application.ActiveExplorer.Selection

Dim oTask As Outlook.TaskItem
Dim oProp As Outlook.UserProperty
Dim oEmail As Outlook.MailItem

For Each oSel In oSels
If oSel.Class = olTask Then
Set oTask = oSel
'Get referenced e-mail attached to the task

Set oProp = oTask.UserProperties.Find("EmailEntryID")
'Get e-mail by EntryID

Set oEmail = objNS.GetItemFromID(oProp.Value)
'Flag e-mail as compeleted
oEmail.FlagRequest = "Task Compeleted on " & Now()
oEmail.FlagIcon = olNoFlagIcon
oEmail.FlagStatus = olFlagComplete
'save changes
oEmail.Save
Set oTask = Nothing
Set oProp = Nothing
Set oEmail = Nothing
End If
Next
MsgBox "referenced e-mail has been flaged for completion successfully"
GoTo x
e:
MsgBox Err.Description
x:
'clear objects from the memory
Set objNS = Nothing
Set currentFolder = Nothing
Set oTask = Nothing
Set oProp = Nothing
Set oEmail = Nothing
End Sub



Ads