Sen – Custom Excel Export


Here’s another twist on exporting items from Outlook to Excel. Senthilblr Kumar (Sen) commented on the original Exporting Outlook Messages to Excel post asking if I could modify it by limiting the export to messages where he is on the “To” line. He doesn’t want to export those where he was copied (CC) or blind copied (BCC). Sen also wants the process to export the starting folder and all sub-folders under it.

To limit the export to messages sent directly to Sen (i.e. not CC’d or BCC’d to him) I added code in the ProcessFolder subroutine that loops through each message’s list of recipients. For each addressee the code compares the recipient’s name to the name of the current user (which should be Sen’s name). When a match is found, the code then check’s the Recipient object’s Type property to see if the entry appears on the “To” line. If the sender addressed the message to Sen, then the recipient object’s Type property will equal olTo. Otherwise it will equal olCC (if Sen was CC’d) or olBCC (if Sen was BCC’d). There is one condition that Sen may not have anticipated: messages addressed to a distribution list. What if the sender sent the message to a distribution list that Sen is a member of? Should the code export those to if the distribution list is entered on the To line? Whether it should or shouldn’t, checking to see if Sen is a member of the distribution list is a bit of a problem. Since distribution lists can be nested the code would have to scan the membership of each list and any sub-lists within it to see if Sen is a member. While that’s doable it’s may be impractical depending on the number of lists and sub-lists. This code does not check distribution lists. It will only export those messages addressed to Sen as an individual on the To line.

Instead of limiting the code to exporting the root folder and all sub-folders underneath it, which might not work for everyone, I added a constant called PROCESS_SUBFOLDERS to control how sub-folders are handled. If the value if set to True, then the code will export sub-folders. Setting it to False will tell the code to only export the root folder.

Adding the code to Outlook.

  1. Start Outlook
  2. Press ALT+F11 to open the 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
'On the next line change True to False if you do not want to export sub-folders
Const PROCESS_SUBFOLDERS = True

Dim excApp As Object, _
    excWkb As Object, _
    excWks As Object, _
    intVersion As Integer, _
    intMessages As Integer

Sub ExportMessagesToExcel()
    Dim strFilename As String
    strFilename = InputBox("Enter a filename (including path) to save the exported messages to.", "Export Messages to Excel")
    If strFilename <> "" Then
        intMessages = 0
        intVersion = GetOutlookVersion()
        Set excApp = CreateObject("Excel.Application")
        Set excWkb = excApp.Workbooks.Add
        Set excWks = excWkb.Worksheets(1)
        'Write Excel Column Headers
        With excWks
            .Cells(1, 1) = "Subject"
            .Cells(1, 2) = "Received"
            .Cells(1, 3) = "Sender"
        End With
        ProcessFolder Application.ActiveExplorer.CurrentFolder
        excWkb.SaveAs strFilename
    End If
    Set excWks = Nothing
    Set excWkb = Nothing
    excApp.Quit
    Set excApp = Nothing
    MsgBox "Process complete.  A total of " & intMessages & " messages were exported.", vbInformation + vbOKOnly, "Export messages to Excel"
End Sub

Sub ProcessFolder(olkFld As Outlook.MAPIFolder)
    Dim olkMsg As Object, olkRec As Outlook.Recipient, olkSub As Outlook.MAPIFolder, intRow As Integer, bolToMe As Boolean
    intRow = excWks.UsedRange.Rows.Count
    intRow = intRow + 1
    'Write messages to spreadsheet
    For Each olkMsg In olkFld.Items
        'Only export messages, not receipts or appointment requests, etc.
        If olkMsg.Class = olMail Then
            bolToMe = False
            'Scan the list of recipients for each message
            For Each olkRec In olkMsg.Recipients
                'Was the message sent to me (i.e. my name is on the To line, not the CC or BCC)?
                If olkRec.Name = Session.CurrentUser And olkRec.Type = olTo Then
                    bolToMe = True
                    Exit For
                End If
            Next
            'The message was sent to me
            If bolToMe Then
                'Add a row for each field in the message you want to export
                excWks.Cells(intRow, 1) = olkMsg.Subject
                excWks.Cells(intRow, 2) = olkMsg.ReceivedTime
                excWks.Cells(intRow, 3) = GetSMTPAddress(olkMsg, intVersion)
                intRow = intRow + 1
                intMessages = intMessages + 1
            End If
        End If
    Next
    Set olkMsg = Nothing
    Set olkRec = Nothing
    If PROCESS_SUBFOLDERS Then
        For Each olkSub In olkFld.Folders
            ProcessFolder olkSub
        Next
    End If
    Set olkSub = Nothing
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

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

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

Using the Code.

  1. With Outlook open select a folder that contains emails.
  2. Run the macro.
  3. When prompted enter a filename to save the export to. You can cancel the export by not entering anything.
  4. The macro will display a dialog-box when it’s finished. The dialog-box includes a count of the number of messages exported.

Notes.

  • This code can easily be modified to export a different set of fields. To do that, change the headings written to the spreadsheet (lines 21-23) and the message fields (lines 55-57).
  • If you don’t want the macro to prompt for a filename each time, then you can change line 12 to strFilename = “Path_and_File_Name”
Advertisements

3 comments on “Sen – Custom Excel Export

  1. Hi David,

    One quick question if i change the below code from

    If olkRec.Name = Session.CurrentUser And olkRec.Type = olTo Then

    to

    If olkRec.Name = senthilblr@yahoo.com And olkRec.Type = olTo Then

    will the macro work.

    Just wanted this as i will be running this code for different email id from my system. for instance if i want the macro to find xyz@yahoo.com it should just export only those mails where xyz@yahoo.com are available. Just want the coding to be universal and not just for one email id

    As always appreciate your help and you are a Super Start

    Regards,
    Sen

    • Hi, Sen.

      You’re close. If you want to use an address instead of name, then change

      If olkRec.Name = Session.CurrentUser And olkRec.Type = olTo Then 

      to

      If olkRec.AddressEntry.Address = "senthilblr@yahoo.com" And olkRec.Type = olTo Then 

      Thanks! I’m happy to be able to contribute.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s