WHY am I so thick?!?!

[maxwello]

Anyone reading this please help me as I just cannot get my head rounds this problem. http://www.mrexcel.com/forum/images/smilies/icon_banghead.gif

I have a macro that sends out an automated email chaser for emails that are at 3 days, 6 days and 10 days but the day count has to be buisness days so I have tried to use the IIf(Weekday(Date) < 1, 2, 0) to get rid of the weekends but I jsut cannot get it straight in my mind how to configure the last part of the formula. http://www.mrexcel.com/forum/images/smilies/icon_wink.gif

So If my email is actually 6 days old and it was sent last Thursday and I am run the macro today (Monday) how do I get it to work out that it is in fact only 3 days old and not 6 days

This is the current code


Select Case Now - f.items(eindex).SentOn
Case Is > 10 - IIf(Weekday(Date) > 1, 2, 0) ' Move Emails over 10 days to No Reply Recieved
f.items(eindex).Categories = Replace(f.items(eindex).Categories, "Pending Sales Response - Macro", "No Response Received")
f.items(eindex).Save
'**********************************************************************
Case Is > 9 - IIf(Weekday(Date) > 1, 2, 0)
Case Is > 8 - IIf(Weekday(Date) > 1, 2, 0)
Case Is > 7 - IIf(Weekday(Date) > 1, 2, 0)
'**********************************************************************
Case Is > 6 - IIf(Weekday(Date) < 1, 2, 0) ' Send final chaser for all emails over 6 days
Set Original = f.items(eindex)
Set r = Original.ReplyAll
r.Attachments.Add Original
r.SentOnBehalfOfName = "xxx (ecommerceonboardingemea@barclays.com)"
r.CC = "xxx" (efisaleseurope@barclays.com) & ""
r.Subject = "Urgent Chaser 2 - " & f.items(eindex).Subject
r.Body = "Please provide a response to the attached email or the request/action will be archived due to no response."
r.Display ' Change to send
'**********************************************************************
Case Is > 5 - IIf(Weekday(Date) < 6, 2, 0)
Case Is > 4 - IIf(Weekday(Date) < 5, 2, 0)
'**********************************************************************
Case Is > 3 - IIf(Weekday(Date) < 4, 2, 0) ' Send initial chaser for all emails over 3 days
Set Original = f.items(eindex)
Set r = f.items(eindex).ReplyAll
r.Attachments.Add Original
r.SentOnBehalfOfName = "xxx (ecommerceonboardingemea@barclays.com)"
'r.CC = " " Can be set to cc Sales
r.Subject = "Urgent Chaser 1 - " & 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

[westconn1]

working like that only really works up to 6 days, as 7 working days could include 2 weekends
to do any more days, may require more complex calculation, though i am sure the working day question will have been asked hundreds of time in forums
searching in google has not really returned any simple method, some methods just loop all the days and count each weekday

i have tried to create a function to calculate the number of working days between any 2 dates
i will post here when i get it working correctly

[Bob Phillips]

You could just create a simple loop


For i = startdate To enddate

enddate = startdate + i
If Weekday(enddate) = 6 Then i = i + 2

days = days + 1
Next i

[maxwello]

Thanks guys, I have played around it with and created the loop as suggested now I jsut need to test it.

Thanks for all your help.

[maxwello]

You could just create a simple loop


For i = startdate To enddate

enddate = startdate + i
If Weekday(enddate) = 6 Then i = i + 2

days = days + 1
Next i

After your post I implemented the below code but now I have an email from last wednesday and its telling me that it is only seven days old how can this be? Does it only go up to 7?


For i = f.items(eindex).SentOn To Date
EndDate = i + DateValue(Date)
If Weekday(EndDate) = 6 Then i = i + 2
days = days + 1
Next i
t = f.items(eindex).Subject

[westconn1]

telling me that it is only seven days oldis that not what you want? 7 working days, sounds correct to me
what result do you require?

[maxwello]

is that not what you want? 7 working days, sounds correct to me
what result do you require?

And that is why the title is what it is...... I am driving myself mad with this MACRO. All i need to do now is delete my email address from the reply all and I am done.

Thanks again for all your help.

[westconn1]

All i need to do now is delete my email address from the reply all and I am done.i thought i addressed this in one of your other threads

[maxwello]

i thought i addressed this in one of your other threads
Thanks you all for the assistance, below is the final code that will send out auto chasers for emails with a specific category and work out the number of working days and delete specific emails from the reply before sending.


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
Dim workdays As Long
Dim recips As Outlook.Recipients
Dim i As Long
Dim t As Outlook.Recipient
Dim Endate As Variant
Dim test As String
Dim objItem As MailItem
Dim reps As String
Dim RemoveThis As VBA.Collection
Dim Recipients As Outlook.Recipients
Dim v As Long
Dim y As Long
Set RemoveThis = New VBA.Collection
Dim StartDate As Date

'*******************Set Email Folder****************************************************
'Set email folders
Set OutApp = New Outlook.Application
Set oMAPI = OutApp.GetNamespace("MAPI")
Set oParentFolder = oMAPI.Folders("Mailbox - ") 'Set mail box where the emails are
Set f = oParentFolder.Folders("Inbox")
'********************Works through emials with specific category****************************************************
For eindex = f.items.Count To 1 Step -1
If InStr(f.items(eindex).Categories, "Pending Response - Macro") > 0 Then
i = Now - f.items(eindex).SentOn
'**************************Works out the number of work days*******************
EndDate = Date
StartDate = f.items(eindex).SentOn
StartDate = Format(StartDate, "dd/mm/yyyy")
For i = StartDate To EndDate
EndDate = StartDate + i
If Weekday(EndDate) = 6 Then i = i + 2
days = days + 1
Next i
'*************************Select Statements for day age buckets******************************************************
Set objItem = f.items(eindex)
Select Case days
Case Is > 10 'Move Emails over 10 days to No Reply Recieved
f.items(eindex).Categories = Replace(f.items(eindex).Categories, "Pending Response", "No Response Received")
f.items(eindex).Save
Case Is = 6 ' Send final chaser for all emails over 6 days
Set Original = f.items(eindex)
Set R = f.items(eindex).ReplyAll
R.Attachments.Add Original
R.SentOnBehalfOfName = "Set email address"
R.CC = "Set email address" & ""
R.Subject = "Urgent Chaser 2 - " & f.items(eindex).Subject
R.Body = "Please provide a response to the attached email or the request/action will be archived due to no response."
'************Deletes the eCommerce Onboarding Email**************
RemoveThis.Add "/Set email address"
Set Recipients = R.Recipients
For v = Recipients.Count To 1 Step -1
Set t = Recipients.Item(v)
For y = 1 To RemoveThis.Count
If LCase$(t.Address) = LCase$(RemoveThis(y)) Then
Recipients.Remove v
Exit For
End If
Next
Next
'****************************************************************
R.Display ' Change to send
Case Is = 3 'Send initial chaser for all emails over 3 days
Set Original = f.items(eindex)
Set R = f.items(eindex).ReplyAll
R.Attachments.Add Original
R.SentOnBehalfOfName = "Set email address"
'r.CC = " " Can be set to cc Sales
R.Subject = "Urgent Chaser 1 - " & f.items(eindex).Subject
R.Body = "Please provide a response to the attached email." '& f.Items(eindex).Body
'************Deletes the eCommerce Onboarding Email**************
RemoveThis.Add "Set email address"
Set Recipients = R.Recipients
For v = Recipients.Count To 1 Step -1
Set t = Recipients.Item(v)
For y = 1 To RemoveThis.Count
If LCase$(t.Address) = LCase$(RemoveThis(y)) Then
Recipients.Remove v
Exit For
End If
Next
Next
'****************************************************************
R.Display ' Change to Send
End Select
End If
days = 0
Next
End Sub