Solved

VBA Script to monitor incoming mails?

Posted on 2013-11-28
20
1,243 Views
Last Modified: 2013-12-06
Outlook + Exchange2007: Can someone tell me if this is possible please.....

I want to set up a Public Folder to contain mail for each of our customers. I want a copy of each incoming email to be stored in the Public Folder for that customer. I started to do this with Transport Rules on the Exchange Server, but we have hundreds of customers. So this would get really messy.

I'm competent in vba. I wondered if I could have a script which executed within Outlook. This would need to be triggered as each incoming mail arrived. My idea is that the script would query our sql server customer database, and if the 'From' address on the incoming email matches a customer email address in the database, then a copy of the email would be sent to that customer's public folder in Exchange.

Is this possible?
0
Comment
Question by:TownTalk
  • 11
  • 9
20 Comments
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
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

Open in new window

0
 

Author Comment

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

Ian
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
You're welcome, Ian.
0
 

Author Comment

by:TownTalk
Comment Utility
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?
0
 

Author Comment

by:TownTalk
Comment Utility
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
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
Comment Utility
Inbox isn't a valid path.  The path to an Outlook folder is composed of all the folders from the root of the mailbox to the target folder, with each folder name separated from the preceding folder name by a backslash.  Depending on which version of Outlook you're using, the path to the Inbox folder will be something like

Doe, John - Mailbox\Inbox
john.doe@company.com\Inbox
0
 

Author Comment

by:TownTalk
Comment Utility
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
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
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.
0
 

Author Comment

by:TownTalk
Comment Utility
I'm copying to a Public Folder, but I want to monitor the Inbox for arriving emails.
0
 

Author Comment

by:TownTalk
Comment Utility
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
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 

Author Comment

by:TownTalk
Comment Utility
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
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
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.
0
 

Author Comment

by:TownTalk
Comment Utility
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
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
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.
0
 

Author Comment

by:TownTalk
Comment Utility
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?
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
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.
0
 

Author Comment

by:TownTalk
Comment Utility
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?
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
No problem.  I should have been more specific.

Set SentItemsFolder = Nothing
0
 

Author Comment

by:TownTalk
Comment Utility
Yes. That works fine now thank you. I should have figured that out for myself. I've been programming in vba for 20 years!
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
Sounds like a "senior moment".  I have them all the time.
0

Featured Post

Control application downtime with dependency maps

Visualize the interdependencies between application components better with Applications Manager's automated application discovery and dependency mapping feature. Resolve performance issues faster by quickly isolating problematic components.

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
outlook, calendar 3 34
Outlook Apps on Andriod 1 24
Exchange vm and snapshots 4 35
exchange 2 32
Not sure what the best email signature size is? Are you worried about email signature image size? Follow this best practice guide.
If you don't know how to downgrade, my instructions below should be helpful.
In this video we show how to create an email address policy in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.:  First we need to log into the Exchange Admin Center. Navigate to the Mail Flow…
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now