WHY am I so thick?!?!

[maxwello]

Anyone reading this please help me as I just cannot get my head rounds this problem.

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.

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"
                    r.CC = "xxx" & ""
                    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"
                    '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 old

is 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