To debug, mouse-click anywhere in the code. Press F8 repeatedly to step through the code. http://www.cpearson.com/excel/DebuggingVBA.aspx
If your problem has been solved in your thread, mark the thread "Solved" by going to the "Thread Tools" dropdown at the top of the thread. You might also consider rating the thread by going to the "Rate Thread" dropdown.
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