' If you don't know beans about programming that's cool
' Here are the things that are safe to change to customize how this works
' The names are relatively friendly and it should make sense what they do
' Only change the stuff on the right of the equal sign and you'll be fine
Private Const ADD_NEW_APPOINTMENTS_TO_CALENDAR As Boolean = True ' True means new appointments will be added to the calendar, don't know why you'd want this false but it's an option
Private Const SEND_ACCEPT_RESPONSE_TO_ALL_DAY_APPOINTMENTS As Boolean = False ' True means an acceptance response will be sent to all day appointments
Private Const PROCESS_ONLY_NEW_ITEMS_ON_STARTUP = False ' True means only new items are processed read items are not; False means every item in the inbox is checked
Private Const PROCESS_ONLY_NEW_ITEMS_ON_NEW_MAIL_ARRIVED = True ' True means only new items are processed, read items are not; False means every item in the inbox is checked
Private Const REMOVE_NEW_MAIL_ICON_IF_NO_NEW_ITEMS_REMAIN = True ' True means the new mail icon will be removed if there are no unread items in the inbox

Private Sub Application_NewMail() ' Event that runs when new mail arrives
    On Error GoTo ExitApplicationNewMail ' Catch any unhandled errors

    ProcessInbox PROCESS_ONLY_NEW_ITEMS_ON_NEW_MAIL_ARRIVED

ExitApplicationNewMail:

End Sub

Private Sub Application_Startup() ' Event that runs when Outlook starts
    On Error GoTo ExitApplicationStartup ' Catch any unhandled errors
    
    ProcessInbox PROCESS_ONLY_NEW_ITEMS_ON_STARTUP

ExitApplicationStartup:

End Sub

Private Sub ProcessInbox(newItemsOnly As Boolean)
    Dim objItem As Outlook.MailItem
    Dim inbox As MAPIFolder
    Dim inboxItem As Object
    Dim newItemCount As Integer
    Dim itemDeleted As Boolean
    Dim currentItemUnread As Boolean
        
    newItemCount = 0
    
    ' If something bad happens opening the mailbox then bail
    On Error GoTo ExitProcessInbox
        
    ' Look for unread items
    Set inbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    For Each inboxItem In inbox.Items
        ' Keep track of unread item count
        itemDeleted = False
        If (inboxItem.UnRead) Then
            currentItemUnread = True
            newItemCount = newItemCount + 1
        End If
        ' Within the loop, if something bad happens go to the next item
        On Error GoTo NextItem
        DoEvents ' Let Outlook do stuff while this loop is executing
        If (newItemsOnly And (currentItemUnread)) Or (newItemsOnly = False) Then
            ' This If/ElseIf block checks for the Class of the inbox item and calls the appropriate handler
            If (inboxItem.Class = olMeetingRequest) Then
                itemDeleted = ProcessMeetingRequest(inboxItem)
            ' ElseIf --- in future posts we'll address other message types, when/if that time comes we'll paste the code here
            End If
        End If
NextItem:
        ' Update unread iteam count if the item was unread and deleted
        If (currentItemUnread And itemDeleted) Then
            newItemCount = newItemCount - 1
        End If
    Next
    
    ' Remove the new mail icon
    If ((REMOVE_NEW_MAIL_ICON_IF_NO_NEW_ITEMS_REMAIN) And (newItemCount > 0)) Then
        RemoveNewMailIcon ' You'll need to download
    End If

ExitProcessInbox:

End Sub

Private Function ProcessMeetingRequest(meetingRequest As MeetingItem)
    Dim appointment As AppointmentItem
    Dim endDate As Date
    Dim itemDeleted As Boolean
    
    itemDeleted = False
        
    ' Stuff happens, for example if an appointment is dismissed without being read it causes GetAssociatedAppointment to explode
    On Error GoTo ExitProcessMeetingRequest
    
    ' Grab a reference to the actual appointment
    Set appointment = meetingRequest.GetAssociatedAppointment(ADD_NEW_APPOINTMENTS_TO_CALENDAR)
    
    If (appointment.RecurrenceState <> olApptNotRecurring) Then
        Dim rp As RecurrencePattern
        Set rp = appointment.GetRecurrencePattern()
        endDate = rp.PatternEndDate
    Else
        endDate = appointment.End
    End If
    
    If (endDate < Date) Then ' If the meeting occurs in the past just delete it
        meetingRequest.Delete
        itemDeleted = True
    ElseIf ((appointment.AllDayEvent = True) Or (appointment.Duration >= 1440)) Then ' Take care of all day appointments - 99% of the time these are vacation notices
        ' Deal with people who accidently (or passive-aggressively) block your calendar
        appointment.BusyStatus = olFree
        ' Same for people who put reminders on everything
        appointment.ReminderSet = False
        ' Accept the appointment
        appointment.Respond olMeetingAccepted, True, True
        If (SEND_ACCEPT_RESPONSE_TO_ALL_DAY_APPOINTMENTS = True) Then
            appointment.Send
        End If
        ' Delete the request
        meetingRequest.Delete
        itemDeleted = True
    Else ' Regular appointment
        ' Delete annoying appointments like "so and so is going to the bathroom from 1:30-2:00"
        If (appointment.BusyStatus = olFree) Then
            meetingRequest.Delete
            itemDeleted = True
        Else
            ' If you ever wanted to write a function to automatically accept/decline other appointment types this would be the place to do it
        End If
    End If
    
ExitProcessMeetingRequest:

    ProcessMeetingRequest = itemDeleted

End Function