New Mail Notification for an Additional Mailbox

This morning I responded to a tweet from Tom Blackman (@itimlalake) asking how to set up a new mail notification for an additional mailbox in Outlook 2007. An additional mailbox in this context is a second mailbox on an Exchange server. Unfortunately, until 2010 Outlook did not support multiple mailboxes. While you could open and view additional mailboxes Outlook did not treat them as it does the primary mailbox. As a result things like new message notification and rules aren’t available for the additional mailboxes.

Fortunately, there is a workaround. It doesn’t look or behave the same as the built-in notification, but it is functional. The solution is to use a bit of scripting to monitor the additional mailbox’s inbox, watch for new items, and display a pop-up dialog-box when it detects one. The dialog-box is a standard Windows’ dialog, not the slick-looking notification that Outlook uses. The dialog doesn’t fade in and out, nor does it offer the ability to open or delete the message as Outlook’s notification dialog does. It will steal focus and you have to click a button to make it go away. While it’s not the best solution, it is a functional solution. Hopefully it will help Tom keep track of messages arriving in the additional mailbox.

The code for this comes in three parts.

Part 1.

Follow these instructions to add this code to Outlook.

1. Start Outlook
2. Click Tools > Macro > Visual Basic Editor
3. If not already expanded, expand Microsoft Office Outlook Objects
4. If not already expanded, expand Modules
5. Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert > Module.
6. Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
7. Edit the code as needed. I included comments wherever something needs to or can change
8. Click the diskette icon on the toolbar to save the changes
9. Close the VB Editor

'On the next line change the file name and path of the sound you want to play.'
Public Const SOUND_TO_PLAY = "C:\Windows\Media\Notify.wav"
Public Const SND_ASYNC = &H1

Public Declare Function sndPlaySound _
    Lib "winmm.dll" Alias "sndPlaySoundA" _ 
        (ByVal lpszSoundName As String, _
        ByVal uFlags As Long) _
    As Long 

Public Declare Function MessageBox _
    Lib "User32" Alias "MessageBoxA" _
        (ByVal hWnd As Long, _
        ByVal lpText As String, _
        ByVal lpCaption As String, _
        ByVal wType As Long) _
    As Long

Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    ' Purpose: Opens an Outlook folder from a folder path.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: All versions'
    Dim arrFolders As Variant, _
        varFolder As Variant, _
        bolBeyondRoot As Boolean
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            Select Case bolBeyondRoot
                Case False
                    Set OpenOutlookFolder = Outlook.Session.Folders(varFolder)
                    bolBeyondRoot = True
                Case True
                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
            End Select
            If Err.Number <> 0 Then
                Set OpenOutlookFolder = Nothing
                Exit For
            End If
        Next
    End If
    On Error GoTo 0
End Function

Part 2.

Follow these instructions to add this code to Outlook.

1. If not already expanded, expand Microsoft Office Outlook Objects
2. Right-click on Class Modules, select Insert > Class Module
3. In the Properties panel click on Name and enter FolderMonitor
4. Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
5. Edit the code as needed. I included comments wherever something needs to or can change
6. Click the diskette icon on the toolbar to save the changes

Private WithEvents olkItems As Outlook.Items

Private Sub Class_Terminate()
    Set olkItems = Nothing
End Sub

Public Sub FolderToWatch(objFolder As Outlook.Folder)
    Set olkItems = objFolder.Items
End Sub

Private Sub olkItems_ItemAdd(ByVal Item As Object)
    Dim lngHandle As Long, lngReturn As Long
    sndPlaySound SOUND_TO_PLAY, SND_ASYNC
    MessageBox &O0, "New message arrived.", olkItems.Parent.Name, vbInformation + vbOKOnly + vbSystemModal 
End Sub 

Part 3.

Follow these instructions to add this code to Outlook.

1. If not already expanded, expand Microsoft Office Outlook Objects and click on ThisOutlookSession
2. Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
3. Edit the code as needed. I included comment lines wherever something needs to or can change
4. Click the diskette icon on the toolbar to save the changes
5. Close the VB Editor
6. Click Tools > Trust Center
7. Click Macro Security
8. Set Macro Security to “Warnings for all macros”
9. Click OK
10. Close Outlook
11. Start Outlook. Outlook will display a dialog-box warning that ThisOutlookSession contains macros and asking if you want to allow them to run. Say yes.

Dim objFM1 As FolderMonitor

Private Sub Application_Quit()
    Set objFM1 = Nothing
End Sub

Private Sub Application_Startup()
    Set objFM1 = New FolderMonitor
    'Edit the folder path on the next line as needed.'
    objFM1.FolderToWatch OpenOutlookFolder("Mailbox - TechnicLee\Inbox") 
End Sub 

Revisions.

• Revision 1

This revision is for Ashok who asked for the ability to have different messages for different mailboxes (i.e. to have different text in the notification based on the mailbox being monitored) and to display the sender’s name in the notification. I added a third new feature, which is the ability to set different sounds for different mailboxes. Adding these features entailed adding three properties to the FolderMonitor class. Those properties are Message (used to set the message shown in the notification dialog-box), Sound (used to set the sound that will be played), and ShowSender (used to control whether the message sender is shown). All three settings are optional and use a default value if you opt not to use them. This makes the code more flexible, satisfying Ashok’s request without changing the code for those of you who don’t want the features that Ashok does.

To implement this revision, replace the code in the respective parts with this code, then close and restart Outlook. Refer to the instructions in the original post for details on how to add the code for each part.

Part 2.

Private WithEvents olkItems As Outlook.Items 
Private strMessage As String 
Private strSound As String 
Private bolShowSender As Boolean

Private Sub Class_Initialize()
    'On the next three lines edit the default values as desired.'
    strMessage = "New message arrived."
    strSound = "C:\Windows\Media\Notify.wav"
    bolShowSender = False
End Sub

Private Sub Class_Terminate()
    Set olkItems = Nothing
End Sub

Private Sub olkItems_ItemAdd(ByVal Item As Object)
    Dim lngHandle As Long, lngReturn As Long
    sndPlaySound strSound, SND_ASYNC
    If bolShowSender Then
        MessageBox &O0, strMessage & vbCrLf & "Sender: " & Item.SenderName, olkItems.Parent.Name, vbInformation + vbOKOnly + vbSystemModal
    Else
        MessageBox &O0, strMessage, olkItems.Parent.Name, vbInformation + vbOKOnly + vbSystemModal
    End If
End Sub

Public Sub FolderToWatch(objFolder As Outlook.Folder)
    Set olkItems = objFolder.Items
End Sub

Public Property Let Message(ByVal strValue As String)
    strMessage = strValue
End Property

Public Property Let ShowSender(ByVal bolValue As Boolean)
    bolShowSender = bolValue
End Property

Public Property Let Sound(ByVal strValue As String)
    strSound = strValue
End Property

Part 3.

Dim objFM1 As FolderMonitor

Private Sub Application_Quit()
    Set objFM1 = Nothing
End Sub

Private Sub Application_Startup()
    Set objFM1 = New FolderMonitor
    With objFM1
        'The next line is optional. Delete it to use the default message. To set a message enter the text you want shown.'
        .Message = "New message in ..."
        'The next line is optional. Delete it or set the value to False if you do not want the sender shown.'
        .ShowSender = True
        'The next line is optional. Delete it to use the default sound. To set a sound edit name/path of the sound to play.'
        .Sound = "C:\Windows\Media\Notify.wav"
        'The next line is not optional.  Edit the folder path on the next line as needed.'
        .FolderToWatch OpenOutlookFolder("Mailbox - TechnicLee\Inbox")
    End With
End Sub

• Revision 2

I created this revision for Jarratt. Jarratt wants to be able to monitor multiple folders, but for one of those folders he only wants a notification if the message came from a certain domain (e.g. gmail.com). This code builds on Revision 1 by adding that filtering capability.

To implement this revision, replace the code in the respective parts with this code, then close and restart Outlook. Refer to the instructions in the original post for details on how to add the code for each part.

Part 2.

Private WithEvents olkItems As Outlook.Items
Private strMessage As String
Private strSound As String
Private bolShowSender As Boolean
Private colFilter As Collection

Private Sub Class_Initialize()
    'On the next three lines edit the default values as desired.'
    strMessage = "New message arrived."
    strSound = "C:\Windows\Media\Notify.wav"
    bolShowSender = False
    Set colFilter = New Collection
End Sub

Private Sub Class_Terminate()
    Set olkItems = Nothing
End Sub

Private Sub olkItems_ItemAdd(ByVal Item As Object)
    Dim strSender As String, strDomain As String
    If Item.Class = olMail Then
        strSender = GetSMTPAddress(Item, GetOutlookVersion())
        On Error Resume Next
        strDomain = colFilter.Item(Mid(strSender, InStr(1, strSender, "@") + 1))
        On Error GoTo 0
        If (strDomain <> "") Or (colFilter.Count = 0) Then
            sndPlaySound strSound, SND_ASYNC
            If bolShowSender Then
                MessageBox &O0, strMessage & vbCrLf & "Sender: " & Item.SenderName, olkItems.Parent.Name, vbInformation + vbOKOnly + vbSystemModal
            Else
                MessageBox &O0, strMessage, olkItems.Parent.Name, vbInformation + vbOKOnly + vbSystemModal
            End If
        End If
    End If
End Sub

Private Function GetSMTPAddress(Item As Outlook.MailItem, intOutlookVersion As Integer) As String
    Dim olkSnd As Outlook.AddressEntry, olkEnt As Object
    On Error Resume Next
    Select Case intOutlookVersion
        Case Is < 14
            If Item.SenderEmailType = "EX" Then
                GetSMTPAddress = SMTP2007(Item)
            Else
                GetSMTPAddress = Item.SenderEmailAddress
            End If
        Case Else
            Set olkSnd = Item.Sender
            If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then
                Set olkEnt = olkSnd.GetExchangeUser
                GetSMTPAddress = olkEnt.PrimarySmtpAddress
            Else
                GetSMTPAddress = Item.SenderEmailAddress
            End If
    End Select
    On Error GoTo 0
    Set olkPrp = Nothing
    Set olkSnd = Nothing
    Set olkEnt = Nothing
End Function

Private Function GetOutlookVersion() As Integer
    Dim arrVer As Variant
    arrVer = Split(Outlook.Version, ".")
    GetOutlookVersion = arrVer(0)
End Function

Private Function SMTP2007(olkMsg As Outlook.MailItem) As String
    Dim olkPA As Outlook.PropertyAccessor
    On Error Resume Next
    Set olkPA = olkMsg.PropertyAccessor
    SMTP2007 = olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001E")
    On Error GoTo 0
    Set olkPA = Nothing
End Function

Public Sub FolderToWatch(objFolder As Outlook.Folder)
    Set olkItems = objFolder.Items
End Sub

Public Property Let Filter(ByVal strValue As String)
    On Error Resume Next
    If colFilter.Item(strValue) = "" Then
        colFilter.Add strValue, strValue
    End If
    On Error GoTo 0
End Property

Public Property Let Message(ByVal strValue As String)
    strMessage = strValue
End Property

Public Property Let ShowSender(ByVal bolValue As Boolean)
    bolShowSender = bolValue
End Property

Public Property Let Sound(ByVal strValue As String)
    strSound = strValue
End Property

Part 3.

Dim objFM1 As FolderMonitor

Private Sub Application_Quit()
    Set objFM1 = Nothing
End Sub

Private Sub Application_Startup()
    Set objFM1 = New FolderMonitor
    With objFM1
        'The next line is optional and may be repeated as many times as necessary.  Enter an email domain name without the @ sign.  This will restrict notifications to just those message from that domain.
        .Filter = "gmail.com"
        'The next line is optional. Delete it to use the default message. To set a message enter the text you want shown.'
        .Message = "New message in ..."
        'The next line is optional. Delete it or set the value to False if you do not want the sender shown.'
        .ShowSender = True
        'The next line is optional. Delete it to use the default sound. To set a sound edit name/path of the sound to play.'
        .Sound = "C:\Windows\Media\Notify.wav"
        'The next line is not optional.  Edit the folder path on the next line as needed.'
        . FolderToWatch OpenOutlookFolder("Mailbox - TechnicLee\Inbox")
    End With
End Sub

• Revision 3

I created this revision for David who asked for a knock-off that adds the ability to save message attachments to a specific folder. I implemented this new capability as an option David can activate on a per-mailbox basis. I also added the ability to display the message subject, sender’s name, or both in the notification dialog.

Part 1.

Follow these instructions to add this code to Outlook.

1. Start Outlook
2. Click Tools > Macro > Visual Basic Editor
3. If not already expanded, expand Microsoft Office Outlook Objects
4. If not already expanded, expand Modules
5. Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert > Module.
6. Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
7. Edit the code as needed. I included comments wherever something needs to or can change
8. Click the diskette icon on the toolbar to save the changes
9. Close the VB Editor

'On the next line change the file name and path of the sound you want to play.'
Public Const SOUND_TO_PLAY = "C:\Windows\Media\Notify.wav"
Public Const SND_ASYNC = &H1

Public Declare Function sndPlaySound _
    Lib "winmm.dll" Alias "sndPlaySoundA" _ 
        (ByVal lpszSoundName As String, _
        ByVal uFlags As Long) _
    As Long 

Public Declare Function MessageBox _
    Lib "User32" Alias "MessageBoxA" _
        (ByVal hWnd As Long, _
        ByVal lpText As String, _
        ByVal lpCaption As String, _
        ByVal wType As Long) _
    As Long

Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    ' Purpose: Opens an Outlook folder from a folder path.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: All versions'
    Dim arrFolders As Variant, _
        varFolder As Variant, _
        bolBeyondRoot As Boolean
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            Select Case bolBeyondRoot
                Case False
                    Set OpenOutlookFolder = Outlook.Session.Folders(varFolder)
                    bolBeyondRoot = True
                Case True
                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
            End Select
            If Err.Number <> 0 Then
                Set OpenOutlookFolder = Nothing
                Exit For
            End If
        Next
    End If
    On Error GoTo 0
End Function

Part 2.

Private WithEvents olkItems As Outlook.Items
Private strMessage As String
Private strSaveToFolder As String
Private strSound As String
Private bolShowSender As Boolean
Private bolShowSubject As Boolean
Private colFilter As Collection

Private Sub Class_Initialize()
    'On the next three lines edit the default values as desired.'
    strMessage = "New message arrived."
    strSaveToFolder = ""
    strSound = "C:\Windows\Media\Notify.wav"
    bolShowSender = False
    bolShowSubject = False
    Set colFilter = New Collection
End Sub

Private Sub Class_Terminate()
    Set olkItems = Nothing
End Sub

Private Sub olkItems_ItemAdd(ByVal Item As Object)
    Dim strSender As String, strDomain As String, strAdditionalInfo As String, olkAttachment As Outlook.Attachment
    If Item.Class = olMail Then
        strSender = GetSMTPAddress(Item, GetOutlookVersion())
        On Error Resume Next
        strDomain = colFilter.Item(Mid(strSender, InStr(1, strSender, "@") + 1))
        On Error GoTo 0
        If (strDomain <> "") Or (colFilter.Count = 0) Then
            sndPlaySound strSound, SND_ASYNC
            If bolShowSender Then
                strAdditionalInfo = "Sender: " & Item.SenderName
            End If
            If bolShowSubject Then
                If strAdditionalInfo = "" Then
                    strAdditionalInfo = "Subject: " & Item.Subject
                Else
                    strAdditionalInfo = strAdditionalInfo & vbCrLf & "Subject: " & Item.Subject
                End If
            End If
            If strSaveToFolder <> "" Then
                For Each olkAttachment In Item.Attachments
                    If Not IsHiddenAttachment(olkAttachment) Then
                        olkAttachment.SaveAsFile strSaveToFolder & Format(Now, "yyyy-mm-dd-hh-nn-ss") & " " & olkAttachment.FileName
                    End If
                Next
            End If
            If strAdditionalInfo = "" Then
                MessageBox &O0, strMessage, olkItems.Parent.Name, vbInformation + vbOKOnly + vbSystemModal
            Else
                MessageBox &O0, strMessage & vbCrLf & strAdditionalInfo, olkItems.Parent.Name, vbInformation + vbOKOnly + vbSystemModal
            End If
        End If
    End If
End Sub

Private Function IsHiddenAttachment(olkAtt As Outlook.Attachment) As Boolean
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Dim olkPA As Outlook.PropertyAccessor, varTemp As Variant
    On Error Resume Next
    Set olkPA = olkAtt.PropertyAccessor
    varTemp = olkPA.GetProperty(PR_ATTACH_CONTENT_ID)
    IsHiddenAttachment = (varTemp <> "")
    On Error GoTo 0
    Set olkPA = Nothing
End Function

Private Function GetSMTPAddress(Item As Outlook.MailItem, intOutlookVersion As Integer) As String
    Dim olkSnd As Outlook.AddressEntry, olkEnt As Object
    On Error Resume Next
    Select Case intOutlookVersion
        Case Is < 14
            If Item.SenderEmailType = "EX" Then
                GetSMTPAddress = SMTP2007(Item)
            Else
                GetSMTPAddress = Item.SenderEmailAddress
            End If
        Case Else
            Set olkSnd = Item.Sender
            If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then
                Set olkEnt = olkSnd.GetExchangeUser
                GetSMTPAddress = olkEnt.PrimarySmtpAddress
            Else
                GetSMTPAddress = Item.SenderEmailAddress
            End If
    End Select
    On Error GoTo 0
    Set olkPrp = Nothing
    Set olkSnd = Nothing
    Set olkEnt = Nothing
End Function

Private Function GetOutlookVersion() As Integer
    Dim arrVer As Variant
    arrVer = Split(Outlook.Version, ".")
    GetOutlookVersion = arrVer(0)
End Function

Private Function SMTP2007(olkMsg As Outlook.MailItem) As String
    Dim olkPA As Outlook.PropertyAccessor
    On Error Resume Next
    Set olkPA = olkMsg.PropertyAccessor
    SMTP2007 = olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001E")
    On Error GoTo 0
    Set olkPA = Nothing
End Function

Public Sub FolderToWatch(objFolder As Outlook.Folder)
    Set olkItems = objFolder.Items
End Sub

Public Property Let Filter(ByVal strValue As String)
    On Error Resume Next
    If colFilter.Item(strValue) = "" Then
        colFilter.Add strValue, strValue
    End If
    On Error GoTo 0
End Property

Public Property Let Message(ByVal strValue As String)
    strMessage = strValue
End Property

Public Property Let SaveToFolder(ByVal strValue As String)
    If strValue <> "" Then
        strSaveToFolder = strValue & IIf(Right(strValue, 1) = "\", "", "\")
    End If
End Property

Public Property Let ShowSender(ByVal bolValue As Boolean)
    bolShowSender = bolValue
End Property

Public Property Let ShowSubject(ByVal bolValue As Boolean)
    bolShowSubject = bolValue
End Property

Public Property Let Sound(ByVal strValue As String)
    strSound = strValue
End Property

Part 3.

Dim objFM1 As FolderMonitor

Private Sub Application_Quit()
    Set objFM1 = Nothing
End Sub

Private Sub Application_Startup()
    Set objFM1 = New FolderMonitor
    With objFM1
        'The next line is optional and may be repeated as many times as necessary.  Enter an email domain name without the @ sign.  This will restrict notifications to just those message from that domain.
        .Filter = "gmail.com"
        'The next line is optional. Delete it to use the default message. To set a message enter the text you want shown.'
        .Message = "New message in ..."
        'The next line is optional.  Delete it if you do not want to save the message attachments.  If you include this parameter, then the attachments will be saved to the specified folder.
         .SaveToFolder = "C:\Users\David\Documents\"
        'The next line is optional. Delete it or set the value to False if you do not want the sender shown.'
        .ShowSender = True
        'The next line is optional. Delete it or set the value to False if you do not want the subject shown.'
        .ShowSubject = True
        'The next line is optional. Delete it to use the default sound. To set a sound edit name/path of the sound to play.'
        .Sound = "C:\Windows\Media\Notify.wav"
        'The next line is not optional.  Edit the folder path on the next line as needed.'
        . FolderToWatch OpenOutlookFolder("Mailbox - TechnicLee\Inbox")
    End With
End Sub

• Revision 4

I created this revision for Jimmy who asked for a version that would monitor the Inbox folder of every shared mailbox whose name begins with “FAX -“. The code searches through the message stores defined in the user’s Outlook profile and creates a folder monitor object for each store whose display name begins with “FAX -“. The folder monitor object will display a notification each time an item is added to the Inbox folder of the message store it’s associated with.

Part 1.

Follow these instructions to add this code to Outlook.

1. Start Outlook
2. Click Tools > Macro > Visual Basic Editor
3. If not already expanded, expand Microsoft Office Outlook Objects
4. If not already expanded, expand Modules
5. Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert > Module.
6. Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
7. Click the diskette icon on the toolbar to save the changes
8. Close the VB Editor

Public Const SND_ASYNC = &H1

Public Declare Function sndPlaySound _
    Lib "winmm.dll" Alias "sndPlaySoundA" _ 
        (ByVal lpszSoundName As String, _
        ByVal uFlags As Long) _
    As Long 

Public Declare Function MessageBox _
    Lib "User32" Alias "MessageBoxA" _
        (ByVal hWnd As Long, _
        ByVal lpText As String, _
        ByVal lpCaption As String, _
        ByVal wType As Long) _
    As Long

Part 2.

Follow these instructions to add this code to Outlook.

1. If not already expanded, expand Microsoft Office Outlook Objects
2. Right-click on Class Modules, select Insert > Class Module
3. In the Properties panel click on Name and enter clsFolderMonitor
4. Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
5. Edit the code as needed. I included comments wherever something needs to or can change
6. Click the diskette icon on the toolbar to save the changes

Private WithEvents olkItems As Outlook.Items
Private strMessage As String
Private strSound As String
Private bolShowSender As Boolean
 
Private Sub Class_Initialize()
    'On the next three lines edit the default values as desired.'
    strMessage = "New message arrived."
    strSound = "C:\Windows\Media\Notify.wav"
    bolShowSender = False
End Sub
 
Private Sub Class_Terminate()
    Set olkItems = Nothing
End Sub
 
Private Sub olkItems_ItemAdd(ByVal Item As Object)
    Dim lngHandle As Long, lngReturn As Long
    sndPlaySound strSound, SND_ASYNC
    If bolShowSender Then
        MessageBox &O0, strMessage & vbCrLf & "Sender: " & Item.SenderName, olkItems.Parent.Name, vbInformation + vbOKOnly + vbSystemModal
    Else
        MessageBox &O0, strMessage, olkItems.Parent.Name, vbInformation + vbOKOnly + vbSystemModal
    End If
End Sub
 
Public Sub FolderToWatch(objFolder As Outlook.Folder)
    Set olkItems = objFolder.Items
End Sub
 
Public Property Let Message(ByVal strValue As String)
    strMessage = strValue
End Property
 
Public Property Let ShowSender(ByVal bolValue As Boolean)
    bolShowSender = bolValue
End Property
 
Public Property Let Sound(ByVal strValue As String)
    strSound = strValue
End Property

Part 3.

Follow these instructions to add this code to Outlook.

1. If not already expanded, expand Microsoft Office Outlook Objects
2. Right-click on Class Modules, select Insert > Class Module
3. In the Properties panel click on Name and enter clsJimmy
4. Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
5. Edit the code as needed. I included comments wherever something needs to or can change
6. Click the diskette icon on the toolbar to save the changes

Private colMon As Collection

Private Sub Class_Initialize()
    Dim olkSto As Outlook.Store, objTmp As clsFolderMonitor
    Set colMon = New Collection
    For Each olkSto In Session.Stores
        If Left(olkSto.DisplayName, 5) = "FAX -" Then
            Set objTmp = New clsFolderMonitor
            With objTmp
                .FolderToWatch olkSto.GetDefaultFolder(olFolderInbox)
                .Message = "New message in mailbox " & olkSto.DisplayName
                .ShowSender = True
            End With
            colMon.Add objTmp, olkSto.DisplayName
        End If
    Next
    Set olkSto = Nothing
End Sub

Private Sub Class_Terminate()
    Dim intPtr As Integer, objTmp As clsFolderMonitor
    For intPtr = colMon.Count To 1 Step -1
        Set objTmp = colMon(intPtr)
        Set objTmp = Nothing
    Next
    Set objTmp = Nothing
    Set colMon = Nothing
End Sub

Part4.

Follow these instructions to add this code to Outlook.

1. If not already expanded, expand Microsoft Office Outlook Objects and click on ThisOutlookSession
2. Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
3. Click the diskette icon on the toolbar to save the changes
4. Close the VB Editor
5. Click Tools > Trust Center
6. Click Macro Security
7. Set Macro Security to “Warnings for all macros”
8. Click OK
9. Close Outlook
10. Start Outlook. Outlook will display a dialog-box warning that ThisOutlookSession contains macros and asking if you want to allow them to run. Say yes.

Dim objFM1 As clsJimmy

Private Sub Application_Quit()
    Set objFM1 = Nothing
End Sub

Private Sub Application_Startup()
    Set objFM1 = New clsJimmy
End Sub