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