Need Help with finding/updating task

Joined
Aug 15, 2015
Messages
1
Reaction score
0
Hi!

I'm new to Outlook VBA macros and I'm wondering if someone here could be kind enough to help me out.

My Goal: What I'm trying to do is have a macro that looks at the email's subject heading for a keyword, "SR" when I hit Send button. If it exists, prompt me with a message to create a Task (or automatically create it) with the same subject heading as the email's and a due date 4-5 days from now. If a task with the same subject heading already exist, then either delete it and create a new one or update it with the new date.

The Problem I Currently Have: My script some what works. It prompts and creates a new Task based on the email's subject heading. However, it creates a new task for every time I send the email with the same subject heading (i.e. emails of the same thread). So I end up with multiple tasks getting created. I tried implementing search functions but I don't know what the proper command to us and how to get it to work. If you can show me how to do so or if you can think of a better way to do this, I would be much appreciated.

Here is what I have so far.

Private Sub MyMailItem_Send(Cancel As Boolean)
Dim olApp As Outlook.Application
Dim olTask As Outlook.TaskItem
Dim oFolder As Outlook.MAPIFolder
Set oFolder = Application.Session.GetDefaultFolder(olFolderTasks)
Set colItems = oFolder.Items
Dim strSubject As String
Dim objSch As Outlook.Search

If InStr(MyMailItem.Subject, "Mentor Graphics SR") > 0 Then
If MsgBox("Create A Follow Up Task?", vbYesNo) = vbYes Then
Set olApp = Application
strSubject = "Follow Up: " & MyMailItem.To & " : About :" & MyMailItem.Subject
Dim strFilter As String
strFilter = "urn:schemas:httpmail:subject = " & strSubject
Const strScope As String = "'Tasks'"
Set objSch = olApp.AdvancedSearch(strScope, strFilter)

If objSch <> Null Then
olTask.Delete
MsgBox ("Tasks Found")
Else
Set olTask = olApp.CreateItem(olTaskItem)
olTask.Subject = "Follow Up: " & MyMailItem.To & " : About :" & MyMailItem.Subject
olTask.Body = olTask.Body & MyMailItem.Body & vbCrLf
olTask.Categories = Replace(MyMailItem.To, ",", "-")
olTask.DueDate = Date + 4
olTask.Status = olTaskWaiting
olTask.Display
olTask.Save
olTask.Close (olSave)
End If
End If
End If
End Sub
 
Back
Top