VBA Script to monitor incoming mails?

Hi, TownTalk.

Yes, this is possible.  You can do it by writing a procedure that's triggered by the ItemAdd event of a Folder object's Items collection.  Each Outlook Folder object has an Items collection.  The ItemAdd event fires each time an item is added to that folder.  For this to work, the computer with the code will have to be running all the time.  

Here's how I'd do it.  This code must go in the ThisOutlookSession module.  Here's how it works.

1.  The Application_Startup routine fires automatically each time Outlook starts.  It initiates monitoring of the public folder.
2.  The objFolder_ItemAdd routine fires each time an item is added to the public folder.  The item that was added is passed as a parameter.
3.  The Application_Quit routine fires automatically each time Outlook is shut down.  It stops monitoring and deletes the objFolder object to prevent memory leaks.
4.  The OpenOutlookFolder function is one I wrote.  It takes a path and returns an Outlook folder object.

Dim WithEvents objFolder As Outlook.Items

Private Sub Application_Startup()
    Set objFolder = OpenOutlookFolder("Path_to_the_Public_Folder").Items
End Sub

Private Sub Application_Quit()
    Set objFolder = Nothing
End Sub

Private Sub objFolder_ItemAdd(ByVal Item As Object)
    'Your code goes here
    'Item.SenderEmailAddress contains the sender's address
End Sub

Public Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    ' Purpose: Opens an Outlook folder from a folder path.
    ' Written: 4/24/2009
    ' Author:  David Lee
    ' 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

Select allOpen in new window

Thanks for the reply! I'm out of the office today. I'll give this a go in the morning.

Ian

You're welcome, Ian.

Ok i'm working on this now.... I dont know if affects things, but your code example seems to be written from the point of view of watching for items being added to a Public Folder. Actually I want to monitor items arriving in each users InBox and copy items to the appropriate Public Folder when the email address is matched to our customer database.

So in the Application_Startup routine, what syntax should I use to substitute "Path_to_the_Public_Folder" with the path to the user's Inbox?

I tried your code with "Inbox" substituted as the folder name. When I open Outlook, I get error 91: Objextvariable or With blcok variable not set

Actually I found that this works:

Private Sub Application_Startup()
    Dim MyNameSpace As Outlook.NameSpace
    Dim OutlookApp As Outlook.Application

    Set OutlookApp = Outlook.Application
    Set MyNameSpace = OutlookApp.GetNamespace("MAPI")
    Set objFolder = MyNameSpace.GetDefaultFolder(olFolderInbox).Items
End Sub

But you got me started. So I think i'll be ok now. Thanks for your help

You're welcome.

Yes, that works too, but I thought you were going for a public folder.  That's why I used the approach I did.

I'm copying to a Public Folder, but I want to monitor the Inbox for arriving emails.

Yes i'm sorry, I just read my original question again. I didn't make it clear that the incoming emails would be arriving in the Inbox

I've got my code working very nicely now thanks. But just one more question please.... If I want to do the same for outgoing mails, should I be monitoring the Outbox or Sent Items? or does it not matter?

Ian

Ian,

Assuming that you want to copy the outgoing items to a public folder, then you should monitor the Sent Items folder.  One caveat about that, if you configure Outlook to file sent items in the folder you're responding from (as opposed to having them go to Sent Items), then monitoring Sent Items won't work.  You'd have to monitor every Outlook folder to make this work.

If I understand you correctly, I think we're ok. We want to file a copy of the item, leaving the original in the Sent Items folder.

I'm just trying to debug an annoying issue...

If I put a break point anywhere in my routine (even at the end), I can step through and the process succeeds. However, if I turn the routine loose and let it execute without any breakpoints, it gives a type mismatch error at the start of the routine. But even though the error has occured at the start of the routine, I find that a copy of the email has already appeared in the Public Folder. So I think the routine is executing a second time because the copied item has been temporarily appeared in the Sent Items folder, and the routine is falling over because the first itteration has moved the copied item to the Public Folder. you can see in my code below that I commented out the On Error statement because this is the only way to find out which statement caused the error

Private Sub SentItemsFolder_ItemAdd(ByVal Item As Object)
    'On Error GoTo ProcError
    Dim Message As String
    Dim MyCustomerName As String
    Dim CustomerFolder As MAPIFolder
    Dim CopiedItem As MailItem
    Dim RecipientNo As Integer
               
    'Error occurs here, but the item has already appeared in the Public Folder
     For RecipientNo = 1 To Item.Recipients.Count  
   
        MyCustomerName = GetCustomerName(Item.Recipients(RecipientNo).Address)
        If MyCustomerName <> "" Then
       
            Set CustomerFolder = GetCustomerFolder(MyCustomerName)
         
            Set CopiedItem = Item.Copy
   
            CopiedItem.Move CustomerFolder
       
       End If
    Next RecipientNo
               
ProcExit:

    Set CustomerFolder = Nothing
    Set CopiedItem = Nothing
                 
    Exit Sub
   
ProcError:
   
    MsgBox Error$, "error handling mail transmission"
    Resume ProcExit
   
End Sub

Yes, the error is a result of copying the item.  Copying the item adds a duplicate of the message to the folder.  Adding a new item triggers the ItemAdd event which executes the code on the new item.  It will copy the copy and the cycle repeats, creating an infinite loop.  The solution is to stop watching the Sent Items folder before the copy and start watching it again right after the copy.

Sorry for the delay. I've only just had the chance to look at this again, You say that I need to stop watching the folder temporarily. Do you mean that I should set the folder object to Null? and then reassign it afterwards?

Yes, that's it exactly.  Unfortunately, Outlook's object model doesn't offer a CopyTo method.  The choices are to Copy or Move an item.  Moving will remove the item from the source folder, which you don't want.  Copying creates the copy in the same folder, which triggers the ItemAdd event and causes the loop.  You could try and come up with some other way of recognizing that the new item is the result of a copy, but it's a lot simpler to just stop monitoring the folder, copy the item, then reactivate monitoring.

Sorry to be a pain with this.... I've done as you suggested. Before the copy i've got this line of code:

 Set SentItemsFolder = Null

When my code executes. It stops on this line and gives the error 'Object required' Any ideas?

No problem.  I should have been more specific.

Set SentItemsFolder = Nothing

Yes. That works fine now thank you. I should have figured that out for myself. I've been programming in vba for 20 years!

Sounds like a "senior moment".  I have them all the time.