Last month we discussed how to get data from Microsoft Access into Outlook objects, such as in the creation of new appointments, tasks, contacts and emails.
This month we perform the reverse operation: get data out of Outlook into Microsoft Access. One might argue that there is an easier way to accomplish what I show below, by using Access linked tables to Outlook or Exchange data, but keep these two things in mind:
1) The point of this article is to explain Outlook Automation
2) There are fields available through automation not exposed in linked tables.
The code download that was posted last month contains the demo code for both articles. It is made available again in this link.
The idea for the following solution came from a management request that users be able to upload their emails into a Contacts database where other sales reps could see the history of email correspondence with each contact. Accomplishing this requires:
- scanning the users email folder(s)
- assessing whether an email should be processed
- determining if it has already been processed
- saving message details to a database
Before we explain the solution, there are a couple of things its important to mention. While this code could run automatically when a user opens the application, it may or may not be ethical to secretly extract all of their correspondence into a database to which others have access. In my implementation I always left it up to the user to initiate the extraction and gave them control over which folder(s) were processed.
Why? Well one might argue that any emails on an employees work computer are fair game, but I can imagine a number of scenarios where a user might have legitimate correspondence that should remain confidential. For example, an employee who chooses to inform HR via email that they are HIV positive might do so with the expectation of privacy.
An additional consideration has to do with performance. I found that some of our users have tens of thousands of emails in their Inbox and Sent folders. Processing them all requires no trivial amount of time. In my implementations, I included a date filter so that processing would be limited to a user-selected date. I also implemented a Cancel function so the user could gracefully exit from the process if it was taking too long. You wont find the code for the Cancel feature in the demo but its not difficult to implement. If you want direction on that, post back to this article and Ill write up the process.
One final point: The code in the article has been modified to avoid line breaks where possible and will not exactly correspond to that found in the demo code. I also noticed that some of my comment lines in the demo code were nonsense. Since it had already been rolled out, I didnt try to go back and correct it. Comments have a way of becoming obsolete.
Enumerate Outlook Mail Folders
The first step is to give the user an option for which mail folders they wish to process. To keep the demo simple only the Inbox, Sent Mail and their subfolders will be considered. Since subfolders of subfolders are also enumerated, a function must be created that may be called recursively.
Below are the results from a scan of my Outlook folders where my subfolders go only 1 level deep below the Inbox and Sent Items. Part of the enumeration process is to get a count of the number of items in each folder, which is displayed on the left. This listbox control has its properties set to allow for multiple selections and the Process Emails function will loop through the list and process only those folders and subfolders that have been selected.
Hooking into an Outlook folder is relatively simple. You basically need only two things: An instantiated Outlook object and a folder identifier. For our top folders (Inbox and Sent Items) we need to pass the constants supplied by Outlook to the GetDefaultFolder method. Since this example uses late binding and no reference to the Outlook Library is set, I included comments clarifying that Inbox is 6 and Sent Items is 5.
As with last months article, we use late binding here and the CreateObject() method to set the object variable oOutApp to an instance of Microsoft Outlook. Once we have the application object, we can instantiate a top folder object for either the Inbox or Sent Items. This is all accomplished in the function named GetMAPISubfolders() which accepts a long integer value to identify which of our two top folders to process.
Public Function GetMAPISubfolders(ByVal lFldNum As Long) As String On Error Resume Next Dim oOutApp As Object ' Outlook.Application Dim objTopFld As Object ' Received Mail ... Inbox lFldNum = 6 ' Sent Mail ... Sent Items lFldNum = 5 Set oOutApp = CreateObject("Outlook.Application") Set objTopFld = oOutApp.GetNamespace("Mapi").GetDefaultFolder(lFldNum) ' begin the recursive process with the top folder. Call EnnumerateFolders(objTopFld, lFldNum)
Heres where the recursion comes in. The EnumerateFolders() function, when it encounters a subfolder, calls the EnumerateFolders() function, which in turn calls the EnumerateFolders() function on its subfolders and the process continues in recursion until there are no more subfolders.
Each time it finds a folder, it writes the metadata to a table, which ends up as the source of the listbox shown above in the demo form.
Private Sub EnnumerateFolders(ByRef oFld As Object, ByVal lFldNum As Long) On Error Resume Next Dim oFld As Object Dim strIns As String Dim strSQL As String Dim arrFlds() As String Dim intDep As Integer Dim strFld As String Dim intCnt As Integer ' We will load the folder list with an INSERT statement. strIns = "INSERT INTO tblOutlookFolders " & _ "([FolderType],[FolderName],[ItemCount],[Depth]) " ' oFld.FolderPath = \\Mailbox - Lesandrini\Inbox \Archive ' By counting the slashes (allowing for the 2 in front) you ' can determine the folder depth arrFlds = Split(oFld.FolderPath, "\") intDep = UBound(arrFlds) - 2 strFld = Replace(oFld.Name, "'", "''") intCnt = oFld.Items.Count ' Insert the folder info into tblOutlookFolders. ' The [Depth] column tells us how many folders downstream ' we are so we know how far to indent in the listbox. strSQL = strIns & "VALUES (" & lFldNum & ",'" & _ strFld & "'," & intCnt & "," & intDep & ")" CurrentDb.Execute strSQL ' process all the subfolders of this folder For Each oFld In oFld.folders Call EnnumerateFolders(oFld, lFldNum) Next Set oFld = Nothing
The code is pretty straight-forward but a few notes of clarification. I perform a REPLACE() on the folder name to replace single quotes with a pair of single quotes. This is to ensure that the INSERT statement doesnt fail when processing a folder thats named something like OBrian, with an embedded apostrophe. One could use a recordset object to add the record, which is how its handled in the next example, but I like to switch it up to keep things interesting.
The only other thing that might not be obvious is the intDep variable. It represents the depth of the subfolder. The top folder is 1, the first subfolder is 2, etc. Later this number will be used to add n groups of dots (. . .) to give the subfolders the correct depth. A fancy implementation could use the Treeview control, which is effectively what Microsoft Outlook does, but I wanted to keep it as simple as possible and focused on the Outlook automation model.
Youve Got Mail
Now that folders have been enumerated, we can process the emails within a selected folder. The demo application includes the code for processing selected rows of the list box and its basic stuff, so I wont reproduce that here but the function it calls to process all emails for a named folder is shown below.
Whats important to note here is that the variables lFolder and sFolder are passed to this function. lFolder will either be 6 for Inbox or 5 for Sent Items and sFolder is the folders name/label. Given those two pieces of information, you can instantiate a folder object and process it.
Note too that the Redemption model is implemented here. Outlook security doesnt like it when its objects are accessed via automation so if you want to avoid making the user click through security warning dialogs, then follow the example below using a Redemption SafeItem. (See last months article for a full explanation of the Redemption library.)
Public Function ProcessOutlookFolder( ByVal lFolder As Long, sFolder As String, Optional ByVal dFromDate As Date) As Boolean On Error GoTo Err_Handler Dim appOutlook As Object ' Outlook.Application Dim objFolder As Object ' Outlook.MAPIFolder Dim objSubFld As Object ' Outlook.MAPIFolder Dim objInboxItems As Object ' Outlook.Items Dim objOutMail As Object ' Outlook.MailItem Dim objSafeItem As Object Dim strEntryID As String Dim intRecip As Integer Dim strRecip As String Dim strSubject As String Dim strFrom As String Dim dteSentDate As Date Dim strBody As String Dim intPriority As Integer Dim strCC As String Dim strSQL As String Dim iCount As Integer Dim strAddress As String Dim strType As String Dim dbs As DAO.Database Dim rstNew As DAO.Recordset Dim strLogin As String Dim fExists As Boolean Dim strMsg As String ' assume success ProcessOutlookFolder = True Set dbs = CurrentDb If IsMissing(dFromDate) Then dFromDate = Date - 14 strLogin = "Demo User" If lFolder = 6 Then strType = "Inbox" Else strType = "Sent" Set oOutApp = CreateObject("Outlook.Application") Set oFld = oOutApp.GetNamespace("Mapi").GetDefaultFolder(lFolder) Set oSFld = GetEnummeratedFolder(oFld, sFolder) Set oFldItems = oSFld.Items Set oSafe = CreateObject("Redemption.SafeMailItem") For Each oItem In oFldItems oSafe.Item = oItem With oSafe strEntryID = .EntryID dteSentDate = .SentOn strSubject = .Subject ' Having collected the message EntryID, we can check ' the database to see if this message has already ' been processed. Based on that query, it is either ' added or skipped and the appropriate message shown. strSQL = "SELECT * FROM tblEmailMsgs " & _ "WHERE [EntryID]='" & strEntryID & "'" Set rstNew = dbs.OpenRecordset(strSQL, dbOpenDynaset) fExists = Not (rstNew.BOF And rstNew.EOF) iCount = iCount + 1 If fExists = True Then strMsg = iCount & " ... already exists ... " & _ dteSentDate & " ... " & strSubject Else strMsg = iCount & " ... process new ... " & _ dteSentDate & " ... " & strSubject End If DoCmd.Echo True, strMsg DoEvents ' Only process emails less than date specified. If dteSentDate < dFromDate Then Exit For Else If fExists = True Then ' don't process further Else strBody = .Body intPriority = .Importance strCC = .CC strFrom = .SenderEmailAddress strRecip = "" For intRecip = 1 To .Recipients.Count strAddress = .Recipients(intRecip).Address & ";" strRecip = strRecip & strAddress & ";" Next With rstNew .AddNew !EntryID = strEntryID !Priority = intPriority !Subject = strSubject !BodyText = strBody !FolderName = Left(sFolder, 32) !FolderType = strType !ToAddress = Left(strRecip, 1024) !FromAddress = Left(strFrom, 128) !CCAddress = Left(strCC, 512) !SentDate = dteSentDate !CreatedDate = Now() !CreatedBy = strLogin .Update End If End With End If End If End With Next
This is the function you will need to modify to meet your own personal needs. One feature we implemented was an email lookup to our Customer Relationship Management database. If the email address wasnt found to be in the database, the item was skipped. This saved us from importing hundreds of spam and other emails that were not relative to our contacts database.
If you dont have a CRM list of emails you may wish to limit the import to persons who appear in your contact lists. To do this, we implement another piece of the Outlook automation mechanism, hooking into the address list object.
Enumerate Contact List
The code that follows was extracted from a newsgroup post by Doug Haigh nearly a decade ago. Doug was having some issues with the code but I got it working and the final result is in the download for this article.
The function, DistListPeek(), peeks into all the distribution lists and allows you to extract the names and email addresses. As you might expect, the Outlook Security model doesnt like it when code does this either, so again your users will get a security dialog asking for permission to proceed. It seems like the Redemption library should allow a way to circumvent this, but my initial attempts proved unsuccessful.
Again, I have a local table where the list items are saved for display on the demo form. The code simply instantiates an Address List object and interrogates it for lists and items, inserting each one into the temp table as it goes. I found that some text parsing and cleanup had to be done to get a good list and once again, this extent cleanup may depend on the quality of your address lists.
Function DistListPeek() On Error Resume Next Dim oOut As Object ' Outlook.Application Dim oNS As Object ' Outlook.NameSpace Dim oAL As Object ' Outlook.AddressList Dim oDL As Object ' Outlook.AddressEntry Dim sSQL As String Dim iPos As Integer Dim sList As String Dim sName As String Dim sType As String Dim sEmail As String Set oOut = GetOutlookObject() Set oNS = oOut.GetNamespace("MAPI") oNS.Logon , , False, True 'Return the personal address book. Set oNS = oOut.GetNamespace("MAPI") sSQL = "DELETE FROM tblContacts" CurrentDb.Execute sSQL For Each oAL In oNS.AddressLists iPos = 0 sList = oAL.Name For Each oDL In oAL.AddressEntries iPos = iPos + 1 sEmail = oDL.Address sName = oDL.Name sType = oDL.Type ' The Name property sometimes includes the Email address, ' so strip it out. Other times, it IS the email address. sName = Trim(Replace(sName, "(" & sEmail & ")", "")) If sName = "" Then sName = sEmail sList = Replace(sList, "'", "''") sType = Replace(sType, "'", "''") sName = Replace(sName, "'", "''") sSQL = "INSERT INTO tblContacts " & _ "(ListName, ListType, Position, Name, Email) " & _ "VALUES ('" & sList & "','" & _ sType & "'," & iPos & ",'" & _ sName& "','" & sEmail & "')" CurrentDb.Execute sSQL Next Next End Function
From here ...
The best way to understand this process is to run the code in break mode, stepping through it one line at a time. This will allow you to see how the text strings are parsed and to identify any issues that might arise which are peculiar to your mail setup.
Personally, Im very excited about this demo code because it brings together in one place all the snippets Ive used in various applications. Its the kind of thing you could import into an application and start using right away and because it relies on late binding, you neednt worry about the version of Microsoft Outlook that the user has installed. The code supplied with this article should be an adequate starting point for all your Outlook to Access automation projects.