-
Make a task everytime email with certain category is sent
Hi everyone.
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
-
Ah... Only posting in this forum makes magic. I figured it out..!
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.
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
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules