Consulting

Page 2 of 2 FirstFirst 1 2
Results 21 to 22 of 22

Thread: Those dam categorys.

  1. #21
    VBAX Mentor skatonni's Avatar
    Joined
    Jun 2006
    Posts
    347
    Location
    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.

  2. #22
    VBAX Regular
    Joined
    Mar 2014
    Posts
    33
    Location
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •