Hi,
I have the below code that sends automated chasers and files emails after a certain time that are in my inbox.
What I would like to do now is only apply this macro to specific emails that have a certain category applied to them.
Is this possible?
Any assistance would be greatly appreciated.
PHP Code:
Sub ApplicationReminder()
Dim m As Outlook.MailItem
Dim r As Outlook.MailItem
Dim eindex As Integer
Dim Original As Object
Dim OutApp As New Outlook.Application
Dim oMAPI As Outlook.NameSpace
Dim oParentFolder As Outlook.MAPIFolder
Dim oFolder As Outlook.folder
'***********************************************************************
'Set email folders
Set OutApp = New Outlook.Application
Set oMAPI = OutApp.GetNamespace("MAPI")
Set oParentFolder = oMAPI.Folders("my inbox)'Set mail box where the emails are
Set f = oParentFolder.Folders("Inbox")
Set g = oParentFolder.Folders("Inbox").Folders("No Reply Received")
'************************************************************************
For eindex = f.Items.Count To 1 Step -1
Select Case Now - f.Items(eindex).SentOn
Case Is > 7 + IIf(Weekday(Date) > 0, 2, 0) ' Move Emails over 5 days to No Reply Recieved
f.Items(eindex).Move g
'**********************************************************************
Case Is > 5 + IIf(Weekday(Date) > 1, 2, 0) ' Send final chaser for all emails over 4 days
Set Original = f.Items(eindex)
Set r = Original.ReplyAll
r.Attachments.Add Original
r.SentOnBehalfOfName = "test"
r.CC = "test" & ""
r.Subject = "Urgent Chaser - " & f.Items(eindex).Subject
r.Body = "Please provide a response to the attached email within 24hrs or the request/action will be archived due to no response."
r.Display ' Change to send
'**********************************************************************
Case Is > 2 + IIf(Weekday(Date) > 3, 2, 0) ' Send initial chaser for all emails over 2 days
Set Original = f.Items(eindex)
Set r = f.Items(eindex).ReplyAll
r.Attachments.Add Original
r.SentOnBehalfOfName = "test"
r.CC = "Test"
r.Subject = "Urgent Chaser - " & f.Items(eindex).Subject
r.Body = "Please provide a response to the attached email." '& f.Items(eindex).Body
r.Display ' Change to Send
End Select
Next
End Sub