' This file contains the code for the Outlook examples in Chapter 12.
' Copy this code to the ThisOutlookSession module in your VbaProject.OTM project.

Dim ns As NameSpace
Private WithEvents inboxItems As Items
Private WithEvents myExplorer As Explorer

' Listing 12.16 Event handlers for Outlook's Startup and Quit events.
'
Private Sub Application_Startup()
    '
    ' Use the MAPI namespace object
    '
    Set ns = Application.GetNamespace("MAPI")
    '
    ' Get the Inbox Items object
    '
    Set inboxItems = ns.GetDefaultFolder(olFolderInbox).Items
    '
    ' Set the myExplorer object to Outlook's active Explorer
    '
    Set myExplorer = Application.ActiveExplorer
End Sub

Private Sub Application_Quit()
    '
    ' Clear the objects to save memory
    '
    Set inboxItems = Nothing
    Set ns = Nothing
End Sub

' Listing 12.17 Event handler for the Inbox folder's ItemAdd event.
' Use the event handler to specify your custom rule.
'
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
    Dim topFolder As Outlook.MAPIFolder
    Dim rule1Folder As Outlook.MAPIFolder
    '
    ' Store the Personal Folders folder
    '
    Set topFolder = ns.Folders("Personal Folders")
    '
    ' Custom Rule #1
    ' Move messages from "president@whitehouse.gov" OR with "politics" in the body
    '
    If Item.SenderEmailAddress = "president@whitehouse.gov" Or InStr(Item.Body, "politics") <> 0 Then
        Set rule1Folder = topFolder.Folders("Correspondence")
        Item.Move rule1Folder
    End If
    '
    ' Custom Rule #2
    ' Flag messages with "Conference" AND "2005" in the subject
    '
    If InStr(Item.Subject, "Conference") <> 0 And InStr(Item.Subject, "2005") <> 0 Then
        Item.FlagStatus = olFlagMarked
        Item.FlagRequest = "Review"
        Item.FlagIcon = olBlueFlagIcon
        Item.FlagDueBy = Now() + 7
        Item.Save
    End If
End Sub

' Listing 12.18 A procedure to send an e-mail message when Outlook processes a reminder.
'
Private Sub Application_Reminder(ByVal Item As Object)
    Dim msg As MailItem
    '
    ' Create a new message
    '
    Set msg = Application.CreateItem(olMailItem)
    '
    ' Set up the message with your address and the reminder subject
    '
    msg.Recipients.Add Name:="paulm@mcfedries.com"
    msg.Subject = Item.Subject
    msg.Body = "Reminder!" & vbCrLf & vbCrLf
    '
    ' Set up the message body using properties
    ' appropriate to the different reminder types
    '
    Select Case Item.Class
        Case olAppointment
            msg.Body = "Appointment Reminder!" & vbCrLf & vbCrLf & _
            "Start: " & Item.start & vbCrLf & _
            "End: " & Item.End & vbCrLf & _
            "Location: " & Item.Location & vbCrLf & _
            "Appointment Details: " & vbCrLf & Item.Body
     Case olContact
            msg.Body = "Contact Reminder!" & vbCrLf & vbCrLf & _
            "Contact: " & Item.FullName & vbCrLf & _
            "Company: " & Item.CompanyName & vbCrLf & _
            "Phone: " & Item.BusinessTelephoneNumber & vbCrLf & _
            "E-mail: " & Item.Email1Address & vbCrLf & _
            "Contact Details: " & vbCrLf & Item.Body
      Case olMail
            msg.Body = "Message Reminder!" & vbCrLf & vbCrLf & _
            "Sender: " & Item.SenderName & vbCrLf & _
            "E-mail: " & Item.SenderEmailAddress & vbCrLf & _
            "Due: " & Item.FlagDueBy & vbCrLf & _
            "Flag: " & Item.FlagRequest & vbCrLf & _
            "Message Body: " & vbCrLf & Item.Body
      Case olTask
            msg.Body = "Task Reminder!" & vbCrLf & vbCrLf & _
            "Due: " & Item.DueDate & vbCrLf & _
            "Status: " & Item.Status & vbCrLf & _
            "Task Details: " & vbCrLf & Item.Body
    End Select
    '
    ' Send the message
    '
    'msg.Send
    '
    ' Release the msg object
    '
    Set msg = Nothing
End Sub

' Listing 12.19 An event handler that asks whether Outlook should save a copy of an outgoing in the Sent Items folder
'
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim result As Integer
    '
    ' Display the prompt
    '
    result = MsgBox("Save this message in Sent Items?", _
             vbSystemModal + vbYesNo)
    '
    ' Check the result
    '
    If result = vbNo Then
        '
        ' If the user clicked No, don't save the message in Sent Items
        '
        Item.DeleteAfterSubmit = True
    End If
End Sub

' Listing 12.20 An event handler that asks the user for a password before switching to the "Confidential" Folder.
Private Sub myExplorer_BeforeFolderSwitch(ByVal NewFolder As Object, Cancel As Boolean)
    Dim pwd As String
    '
    ' Are we switching to the "Confidential" folder?
    '
    If NewFolder.Name = "Confidential" Then
        '
        ' If so, ask the user for the password
        '
        pwd = InputBox("Please enter the password for this folder:")
        '
        ' Check the password
        '
        If pwd <> "password" Then
            '
            ' If the password doesn't match, cancel the switch
            '
            Cancel = True
        End If
    End If
End Sub