Working With Outlook from Access

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:

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 user’s email folder(s)
• assessing whether an email should be processed
• determining if it has already been processed
• saving message details to a database

Caveat Emptor

Before we explain the solution, there are a couple of things it’s 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 employee’s 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 won’t find the code for the Cancel feature in the demo but it’s not difficult to implement. If you want direction on that, post back to this article and I’ll 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 didn’t 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 month’s 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)

Here’s 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 it’s 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 doesn’t fail when processing a folder that’s named something like O’Brian, with an embedded apostrophe. One could use a recordset object to add the record, which is how it’s 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.

You’ve 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 it’s basic stuff, so I won’t reproduce that here but the function it calls to process all emails for a named folder is shown below.

What’s 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 folder’s 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 doesn’t 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 month’s 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 wasn’t 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 don’t 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 doesn’t 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, I’m very excited about this demo code because it brings together in one place all the snippets I’ve used in various applications. It’s the kind of thing you could import into an application and start using right away and because it relies on late binding, you needn’t 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.

» See All Articles by Columnist Danny J. Lesandrini