Outlook Challenge 1: Who has got the skills

[maxwello]

Ladies and gentlemen,
Problem:
I currently do not have a workflow to track emails that I am sending to clients and then following up if they haven’t responded so months may go by and then the request will only get completed if there is an escalation internally.

Solution:
What I would like to have to solve this issue is a way that when I send the email to the client (it can be categorized or forwarded to a separate folder away from the inbox) if I haven’t received a response in 48hrs the email is automatically resent with a chaser status added to the subject line (Chaser 1 – “original subject line”) and then again if no response is received after another 48 hours a second chaser is sent with an updated subject line (Final Chaser – “original subject line”) and some additional text advising that should they not respond the request will be removed from the system.

Any assistance will be greatly appreciated and if you require any more clarity please let me know.

[westconn1]

it would be possible to loop through all emails in sent items, probably once a day, and resend those required from within the correct time frame, with appropriate change to subject

the macro could be called from a scheduled task

[maxwello]

Thanks for your reply

That sounds like a viable solution apart from the sent items as the emails will sit in a group email box but sent from personal email accounts. Would it be possible to just direct it to any give folder?

If it is would you be able to help me build out the code?

[westconn1]

Would it be possible to just direct it to any give folder?

yes, you can put code in the newmail event to move email, or just set up rules

If it is would you be able to help me build out the code?

yes, but i would need more details to what result you want to achieve

[maxwello]

Hi,
Please see the below steps that I would like to try and automate, give me a shout if you have any questions.

I really appreciate your help.


Mailbox structure:
Inbox
Waiting for reply
No Reply Received

Steps:
1. Email sent to X
2. A copy of the email is moved via rule to "waiting for reply folder"
3. Macro\VBA script runs once a day at 5pm over the "waiting for reply folder" and any emails at 2 days of age are resent but with "Urgent Chaser" added to the subject line.
4. Macro\VBA script runs once a day at 5pm over the "waiting for reply folder" and any emails at 4 days of age are resent but with "Urgent Chaser" added to the subject line and "This inquiry/issue will be achieved if no response is received within 24hours" added to the body of the email and a new team email added to the cc list.
5. Macro\VBA script runs once a day at 5pm over the "waiting for reply folder" and any emails greater than 5 days of age are moved to folder "No Reply Received".
6. ***NICE TO HAVE**** Macro\VBA script tracks emails that are in the "waiting for reply folder" and if a reply is received into the Inbox it moves the original email from the "waiting for reply folder" back into the Inbox.

[westconn1]

2. A copy of the email is moved via rule to "waiting for reply folder"

does this apply to all outgoing emails?

3. Macro\VBA script runs once a day at 5pm over the "waiting for reply folder"

create a daily calendar event for 5 pm with a reminder of 0 time
try like

Private Sub Application_Reminder(ByVal Item As Object)
Dim m As MailItem
If Item.Subject = "autorun" Then
    Set f = GetNamespace("mapi").Folders("personal folders").Folders("pete")
    For Each m In f.Items
        Select Case Now - m.SentOn
            Case Is > 5

            Case Is > 4
                m.Subject = "Urgent Chaser   -   " & m.Subject
            Case Is > 2
                m.Subject = "Chaser1   -  " & m.Subject
        End Select
        m.Send
    Next
End If
End Sub

this should run without error, but you will have to test if it achieves the desired results item 5 can easily be added to this
will look at 6 later

[westconn1]

2.
can you use rules for outgoing messages?

Private Sub Application_Reminder(ByVal Item As Object)
Dim m As MailItem
If Item.Subject = "autorun" Then
    Set f = GetNamespace("mapi").Folders("personal folders").Folders("waiting for reply")
    For Each m In f.Items
        Select Case Now - m.SentOn
            Case Is > 5
                m.Move GetNamespace("mapi").Folders("personal folders").Folders("No reply received")
            Case Is > 4
                m.Subject = "Urgent Chaser   -   " & m.Subject
            Case Is > 2
                m.Subject = "Chaser1   -  " & m.Subject
        End Select
        m.Send
    Next
End If

end sub

where autorun was the name for the calendar event

[maxwello]

Hi,
Thank you so much for your help to get me started I have had to make a couple of changes but overall it works.

Private Sub Application_Reminder(ByVal Item As Object)
Dim m As MailItem
If Item.Subject = "autorun" Then
Set f = GetNamespace("mapi").Folders("Mailbox - Maxwell, Oliver").Folders("Inbox").Folders("waiting for reply")
For Each m In f.Items
Select Case Now - m.SentOn
Case Is > 5
m.Move GetNamespace("mapi").Folders("Mailbox - Maxwell, Oliver").Folders("Inbox").Folders("No reply received")
Case Is > 4
m.SentOnBehalfOfName = "email1"
m.CC = "email1"
m.Subject = "Urgent Chaser - " & m.Subject
m.HTMLBody = Please provide a response to the below email within 24hrs or the request/action will be archived due to no response."
m.Send
Case Is > 2
m.SentOnBehalfOfName = "email1"
m.CC = "email1"
m.Subject = "Chaser1 - " & m.Subject
m.Send
End Select
Next m
End If
End Sub

Was wondering if you had any ideas on the below.

1. Can we amend the code so it only counts business days and not weekends?
2. When sending a chaser for >4 days is it possible to reply all so the text in the above script can be included? The best I can do is add the original email as an attachment.
Set Original = Application.ActiveExplorer.Selection(1)
Set m = Original.ReplyAll
m.Attachments.Add Original
3. Currently when the code is run the original email in the "waiting for reply" folder that is sent as a chaser moves out of the folder is there any way to keep the original copy?
4. I really like the autorun functionality but in testing it doesn’t always trigger the code, could it be something I am doing?
5. When running through the emails in the folder the script will jump out before it has reviewed all emails in the folder any ideas?

[westconn1]

5. probably because some are moved out, the count is changed
4. i doubt it, best to write some log to see what is going on
3. reply to email instead, probably solve #5 & 2 as well

case is > 4
  set r = m.reply
  r.subject = "urgent chaser " & replace(r.subject, "Re:", "")
  r.recipients.add m.to, olto    ' note the original sender will already be in the to list as it is a reply
  r.cc.sentonbehalfofname = email1
  m.send

untested

1. yes some calculation can be done to remove weekends from the count, i will try to post later, but i am not getting involved in public holidays

[maxwello]

HI,
Thanks so much for your help so far. Since speaking yesterday I have developed the code further and now CASE 4 and 2 are working perfectly.

Issues:
1) CASE 5 Moves the emails out but the count goes out and it breaks out of the Select Case without reviewing all of the emails- What is the best way to resolve this?
2) The attachment logic works but I have noticed some attachments are added to the attachment field at the top of the email and others are embedded within the email text at the bottom - Any ideas why this is happening and how to fix it?
3) Can you help with the code to miss out the weekends, don’t worry about bank holidays.
4) Is it possible to build an IF statement depending on the category that has been assigned to the email?
5) Now this maybe not possible but is there any way that we can monitor the inbox throughout the day and if a reply is received the email in the "Waiting for Reply" folder is moved back out to the inbox?

Sub ApplicationReminder()
    Dim m As Outlook.MailItem
    Dim r As Outlook.MailItem
    Dim Original As Outlook.MailItem
    Dim OutApp As New Outlook.Application
    Dim oMAPI As Outlook.NameSpace
    Dim oParentFolder As Outlook.MAPIFolder
    Dim oFolder As Outlook.Folder
   
    Set OutApp = New Outlook.Application
    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").Folders("waiting for reply")
    Set g = oParentFolder.Folders("Inbox").Folders("No Reply Received")

    For Each r In f.Items
    Select Case Now - m.SentOn
            Case Is > 4
                Set Original = m
                Set r = m.ReplyAll
                r.Attachments.Add Original
                r.SentOnBehalfOfName = email1
                r.CC = email1
                r.Subject = "Urgent Chaser   -   " & m.Subject
                r.Body = "Please provide a response to the attached email within 24hrs or the request/action will be archived due to no response." & m.Body
                r.Send
            Case Is > 2
                Set Original = m
                Set r = m.ReplyAll
                r.Attachments.Add Original
                r.SentOnBehalfOfName = email1
                r.CC = email1
                r.Subject = "Urgent Chaser   -   " & m.Subject
                r.Body = "Please provide a response to the attached email." & m.Body
                r.Send
            End Select
        Next r
   
    For Each m In f.Items
    Select Case Now - m.SentOn
            Case Is > 5
               m.Move g
            End Select
        Next m
 
End Sub

[westconn1]

please enclose code in code tags when posting, much more readable

3. i looked at this, but did not finish testing

Select Case Now - m.SentOn
            Case Is > 4 + iif(weekday(date) > 1, 2, 0)
                Set Original = m
Set r = m.ReplyAll
                r.Attachments.Add Original
                r.SentOnBehalfOfName = email1
                r.CC = email1
                r.Subject = "Urgent Chaser   -   " & m.Subject
                r.Body = "Please provide a response to the attached  email within 24hrs or the request/action will be archived due to no  response." & m.Body
                r.Send
            Case Is > 2 + iif(weekday(date) > 3, 2, 0)
                Set Original = m
                Set r = m.ReplyAll
                r.Attachments.Add Original
                r.SentOnBehalfOfName = email1
                r.CC = email1
                r.Subject = "Urgent Chaser   -   " & m.Subject
                r.Body = "Please provide a response to the attached email." & m.Body
                r.Send
            End Select

For Each m In f.Items
Select Case Now - m.SentOn
Case Is > 5
m.Move g
End Select
Next m

as this is a separate loop items will be first processed to send an additional urgent chaser (>4), so it should be run before sending chasers

1. try changing the loop to run on index in reverse like

for eindex = f.items.count to 1 step - 1
  Select Case Now - f.items(eindex).SentOn
     Case Is > 5 + iif(weekday(date) > 0, 2, 0)
        f.items(eindex).Move g
     case is > 4 + iif(weekday(date) > 1, 2, 0)
       ' rest of select code
               End Select
next

change all instances of m to f.items(eindex), r will not change, better to keep all cases in a single loop


4. yes
5. in the newmail event
2. as r is a reply, attachments in the original should be included, no need to add again, original should not be needed in either case

[maxwello]

Hi,
Thanks again for your continued assistance. I ahve amde the changes detailed in your message but I cannot get it to run, I keep getting the run-time error '424'. I have tried a few things to get it to work but I dont think I am referencing the eindex properly. Any ideas?

Please can you also explain more about question 5.
5. in the newmail event

Thanks

[westconn1]

but I dont think I am referencing the eindex properly

as you do not show the code you have tried, hard to say

I keep getting the run-time error '424'

on which line of the code you do not show?

eindex is just a numeric variable, to use to iterate through emails in folder by their index, use a integer or a long variable type

the new mail event runs whenever mail arrives
it is in the dropdown list for application on the thisoutlooksession code pane
you can check if the newest mail to arrive in inbox or other folder, if you use rules, to see if its conversation topic matches some email in waiting for replay folder

[maxwello]

I have sorted the issue with the eindex and everything is working perfectly.

Would you mind helping me with the code for the New mail event as I am having difficulty in getting it started.

Thanks again for your help

[westconn1]

try like

Private Sub Application_NewMail()
Dim i As MailItem, f As Items, a As Attachment, s As MailItem
Set f = GetNamespace("Mapi").Folders("Personal Folders").Folders("Inbox")
Set i = f.Items(f.items.Count)  'newest arrival
set waiting = f.folders("waiting for reply")
for each e in waiting
  if instr(e.conversationtopic, i.conversationtopic) > 0 then ' match
     e.move f
     exit for    ' stop looking
  end if
next

this is totally untested, so you will need to see if the right email is moved
if your subject lines are very similar, incorrect emails may still match by conversationtopic
i would suggest checking the the sender of the reply matches the appropriate sender/ To of the waiting for reply item as well, but as i am unsure of the email formats hard for me to code, but possibly

if i.sendername = e.sendername and instr(e.conversationtopic, i.conversationtopic) > 0 then

[maxwello]

I cannot thank you enough and I am hoping that this will be the last time that I have to bug you as I am so close to achieving what I wanted.

With a bit of tweaking I managed to get this to work, I also added the code to check the sender name but as it is sent to multiple names and can be sent back by one name I decided that just checking the subject line will be enough. However I know have the problem that the original subject line won’t match the new subject line if the person has responded to the chaser email as it will now read "Urgent Chaser - Subject".

I tried adding the "Urgent Chaser -" to the subject line of the existing email in the waiting for reply folder but as the new one contains “Re:” I can’t match them. Is it possible to code for a wildcard and if so what is the code?

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

'***********************************************************************
'Find New email

Set olObject = Application.Session.GetDefaultFolder(olFolderInbox).Items.GetFirst()

'***********************************************************************
'Set email folders 
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")
'***********************************************************************
'Check new emails and match with emails held in Waiting for Reply 
For Each e In g.Items
If InStr(e.ConversationTopic, olObject.ConversationTopic) > 0 Then ' match
e.Move f
Exit For ' stop looking
End If
Next e
End Sub 

Secondly and this is driving me mad, I have manged to mess something up with the setting the Original, can you take a look at the code as I cannot see what I need to change. Ever time I hit Set Origianl = f in CASE 4 I get RUn-time error '13': Type mismatch.

Sub ApplicationReminder()
    Dim m As Outlook.MailItem
    Dim r As Outlook.MailItem
    Dim eindex As Integer
    Dim Original As Outlook.MailItem
    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("Mailbox - Maxwell, Oliver: Ops Client Services (LDN)") 'Set mail box where the emails are
    Set f = oParentFolder.Folders("Inbox").Folders("waiting for reply")
    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 > 5 + IIf(Weekday(Date) > 0, 2, 0) ' Move Emails over 5 days to No Reply Recieved
                    f.Items(eindex).Move g
  '**********************************************************************
            Case Is > 4 + IIf(Weekday(Date) > 1, 2, 0) ' Send final chaser for all emails over 4 days
                Set Original = f
                Set r = f.ReplyAll
                    r.Attachments.Add Original
                    r.SentOnBehalfOfName = "ecommerceonboardingemea"
                    r.CC = "ecommerceonboardingemea"
                    r.Subject = "Urgent Chaser   -   " & f.Subject
                    r.Body = "Please provide a response to the attached email within 24hrs or the request/action will be archived due to no response." & f.Body
                    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
                Set r = f.ReplyAll
                r.Attachments.Add Original
                r.SentOnBehalfOfName = "ecommerceonboardingemea"
                r.CC = "ecommerceonboardingemea"
                r.Subject = "Urgent Chaser   -   " & m.Subject
                r.Body = "Please provide a response to the attached email." & m.Body
                r.Display ' Change to Send
           End Select
        Next
 
End Sub 

[westconn1]

Is it possible to code for a wildcard and if so what is the code?

of course

you could try changing this to, see if it works any better

If InStr(olObject.ConversationTopic, e.ConversationTopic) > 0 Then 'match

else you need to work out which point to start the comparison, then use mid to remove the prefixed re: and urgent chaser
one thing that may make it easier is to force the appended prefixes to the same length, though i note that the code above indicates you are using the same subject prefix for both 2 and 4 day chasers, either way make sure both are the same length (add spaces to suit), for simpler checking

If mid(olObject.ConversationTopic, 23) = e.ConversationTopic

23 being "Urgent Chaser - " & "re:", change to suit, i would still prefer to use instr, but the longer string would always need to be the first argument, to find if the shorter is within, = must be an exact match

[maxwello]

We are done.

Thank you so much for all of your help.

The only thing that I need to figure out is how to get the Application_NewMail() sub to run when a new email comes into a Shared mail box when I have my personal mail box open on the same profile, I have change the Folders so it picks up the right emails but will only run when I get a new mail into my personal inbox. So if you have any ideas on that that would be great.