Make a task everytime email with certain category is sent

[vegard_fv]

Hi everyone. :hi:

I am using a macro to send emails marked with user defined categories in Outlook (see Code 1).

I am also using another code to assign the email to a task in Outlook for later follow.up (see Code 2).

Now I am looking for a way to make Code number 2 run, everytime an email with a certain (user defined) category name is sent.

Is there any way to do this, for example a global macro in "ThisOutlookSession", that checks every last sent email, and if the email is marked with a certain category name, then the Code2 will trigger?

---
'CODE1

Sub SendEmailSpecialCategory()
Dim obApp As Object
Dim NewMail As MailItem

Set obApp = Outlook.Application
Set NewMail = obApp.CreateItem(olMailItem)

With NewMail
.Subject = "#Innsynskrav"
'.To = "example@mail.com"
'.Body = "Hey." & vbCrLf & vbCrLf & "Test email:" & vbCrLf & vbCrLf & "This is just a test email template with Outlook VBA" & vbCrLf & vbCrLf & vbCrLf & "Yours Truly," & vbCrLf & vbCrLf & "Vegard"
.Categories = "MySpecialCategory"
.Display
End With

Set obApp = Nothing
Set NewMail = Nothing

End Sub

---

'CODE2
Sub SetFollowupToMonthEndMacro()


Dim sel As Outlook.Selection
Set sel = Application.ActiveExplorer.Selection


Dim Item As Object
Dim i As Integer


For i = 1 To sel.Count
Set Item = sel.Item(i)
If Item.Class = olMail Then
Dim mail As MailItem
Set mail = Item
mail.MarkAsTask (olMarkNoDate)
mail.TaskStartDate = SetLastDate(Now)
mail.Save
End If


Next i




End Sub


Private Function SetLastDate(pDate As Date) As Date
Dim iDay As Integer
iDay = Day(pDate)
Dim iLastDay As Integer
Select Case Month(pDate)
Case 1, 3, 5, 7, 8, 10, 12
iLastDay = 31
Case 4, 6, 9, 11
iLastDay = 30
Case 2
If (Year(pDate) Mod 4) = 0 Then
iLastDay = 29
Else
iLastDay = 28
End If
End Select


SetLastDate = DateAdd("d", iLastDay - iDay, pDate)


End Function

[vegard_fv]

Ah... Only posting in this forum makes magic. I figured it out..! :thumb

The code beneath (added in ThisOutlookSession) did the trick. It fetches the email with the category property, and from here I can do whatever I want with it. :clap:

Option Explicit
Private WithEvents sentItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace

Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set sentItems = objectNS.GetDefaultFolder(olFolderSentMail).Items
End Sub
Private Sub sentItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim MessageInfo
Dim Result


If TypeName(Item) = "MailItem" Then


MsgBox Item.Categories


End If


ExitNewItem:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ExitNewItem


End Sub