Those dam categorys.

[maxwello]

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.

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 

[westconn1]

try like

  For eindex = f.Items.Count To 1 Step -1
   if f.items(eindex).category = "mycategory" then
    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
          end if
        Next

[maxwello]

Hi,
I had tried this but I keep getting an error message called "Run-time error '438': Object doestn support this property or method", any ideas what needs to be done.

Dim eindex As Integer

Regards
Oliver

[westconn1]

Run-time error '438'

on which line?

try
If instr(f.items(eindex).categories, "mycategory") > 0 Then

[maxwello]

Hi,

The Run time error occured on the line

If f.Items(eindex).Category = "mycategory" Then

and now if I amned the code as per your last post I get "Compile error: User-defined type not defined" at line: Dim eindex As Integerc.

Thanks for your assistance.

Regards
Oliver

[westconn1]

User-defined type not defined" at line: Dim eindex As Integerc.

looks like you got a random keystroke on that line, see you original post, remove the last character

[maxwello]

looks like you got a random keystroke on that line, see you original post, remove the last character

Perfect thank you for your assistance.

[maxwello]

Perfect thank you for your assistance.

Hi,
I need some more help..

I have the below code that monitors emials coming into the inbox and if the subjects match it did move the emails to another folder. However I would now like it to remove the category that has been assigned to the original email. How can I do this as I have tried loads of ways and I cannot get it to work.

Private Sub Application_NewMail()
    Dim i As MailItem, a As Attachment, s As MailItem
    Dim e As Outlook.MailItem
    Dim h As Outlook.MailItem
    Dim OutApp As New Outlook.Application
    Dim oMAPI As Outlook.NameSpace
    Dim oParentFolder As Outlook.MAPIFolder
    Dim oFolder As Outlook.folder
    Dim olObject As Object

    
    Set oMAPI = OutApp.GetNamespace("MAPI")
    Set oParentFolder = oMAPI.Folders("Mailbox - Maxwell, Oliver: Ops Client Services (LDN)")  'Set mail box where the emails are
    Set f = oParentFolder.Folders("Inbox")
    Set g = oParentFolder.Folders("Inbox").Folders("waiting for reply")
    Set olObject = f.Items.GetFirst()
    
    For Each e In f.Items
        If InStr(olObject.ConversationTopic, e.ConversationTopic) > 0 Then ' match
            Set f.Items.Categories.Remove = ""
            Exit For ' stop looking
        End If
    Next e
End Sub

[westconn1]

have you tried
fitems.categoies = ""

[maxwello]

have you tried
fitems.categoies = ""

Hi,
Yes and I get the "Run-time error '438': Object doesnt support this property or method.

I really dont get it.

Regards
Oliver

[westconn1]

on rereading your code
try
e.categories = ""

[maxwello]

on rereading your code
try
e.categories = ""

That does work but not in the way I need it to, maybe there is a smarter way of doing it.

What I want it to do is monitor the emails coming in if one matches any of the subject lines of the emails that are categorized as "Test" then the MACRO will remove the category test from the original email as this will be applied after it was originally sent to the recipient so the incoming email will not have a category applied.

Do you have any bright ideas?

[westconn1]

if you only want to remove a single category (test)
try

e.categories = replace(e.categories, "Test ", "")

i guess you would also need to save the email after changing the categories

other than that i am not quite sure what you want to change

[maxwello]

Hi,
Thanks again for all your help, however I do have one last problem.

Currently the below script is triggered when a new email is sent to my personal inbox. How can I script it so that the code is triggered when a new email is sent to a group inbox?

Private Sub Application_NewMail()
    Dim i As MailItem, a As Attachment, s As MailItem
    Dim e As Outlook.MailItem
    Dim h As Outlook.MailItem
    Dim OutApp As New Outlook.Application
    Dim oMAPI As Outlook.NameSpace
    Dim oParentFolder As Outlook.MAPIFolder
    Dim oFolder As Outlook.folder
    Dim olObject As Object
    Set oMAPI = OutApp.GetNamespace("MAPI")
    Set oParentFolder = oMAPI.Folders("Mailbox - Ecommerce Onboarding EMEA")  'Set mail box where the emails are
    Set f = oParentFolder.Folders("Inbox")
    Set olObject = f.items.GetFirst()
    
    For Each e In f.items
        If InStr(olObject.ConversationTopic, e.ConversationTopic) > 0 Then ' match
            If InStr(e.Categories, "Pending Sales Response - Macro") > 0 Then
            e.Categories = Replace(e.Categories, "Pending Sales Response - Macro", "")
            e.Save
            Exit For ' stop looking
            End If
        End If
    Next e
End Sub

[westconn1]

i have no availability to group mailbox, so difficult to help with that

it would be possible to have an object of mailitems (the content of group mailbox) with events
then use the event of when a new item is added to the mailitems collection

i can not test how to return a reference to a group mailbox, except when it is already open in outlook, then it is activeinspector.currentfolder

[maxwello]

i have no availability to group mailbox, so difficult to help with that

it would be possible to have an object of mailitems (the content of group mailbox) with events
then use the event of when a new item is added to the mailitems collection

i can not test how to return a reference to a group mailbox, except when it is already open in outlook, then it is activeinspector.currentfolder

Hi,
I know you cant test it but could you give me some guidance on how to code this?

thanks

[westconn1]

Public WithEvents itms As Items

Sub initiate()
    Set itms = ActiveExplorer.CurrentFolder.Items
End Sub

you would normally initiate in application.startup, but i can not help with that as you would have to switch to the group mailbox before initiating

public withevents would have to be in thisoutlooksession or a class module

NOTE this will only run while your outlook is open, mails that arrive while your outlook is not running will not be processed

Private Sub itms_ItemAdd(ByVal Item As Object)
    'process incoming items here
End Sub

move all your code here to run when ever an arriving email item is added to the collection

alternatively run a sweep on all email items in the folder, arrived since last sweep
like once a day, or every hour

[maxwello]

Public WithEvents itms As Items

Sub initiate()
    Set itms = ActiveExplorer.CurrentFolder.Items
End Sub

you would normally initiate in application.startup, but i can not help with that as you would have to switch to the group mailbox before initiating

public withevents would have to be in thisoutlooksession or a class module

NOTE this will only run while your outlook is open, mails that arrive while your outlook is not running will not be processed

Private Sub itms_ItemAdd(ByVal Item As Object)
    'process incoming items here
End Sub

move all your code here to run when ever an arriving email item is added to the collection

alternatively run a sweep on all email items in the folder, arrived since last sweep
like once a day, or every hour

[maxwello]

Is there anyway to set up a timer that runs the code every ten seconds, I know you can use the Calendar but thats not an option here is ther any other way to do it?

[westconn1]

tasks or calendar are the only methods i am aware of in outlook, most any code method will make outlook unresponsive while running
there is no application.ontime method in outlook