J.Santos – Custom Excel Export

About two weeks ago I received an email from a gentleman named Jeferson Santos asking if I could help him solve a problem. Jeferson went on to say that he had seen my post Exporting Outlook Messages to Excel and was

… looking for a similar routine to export my e-mail messages from Outlook to Excel but with some customizations according to my needs.

Jeferson receives a specific category of message that he wants to process automatically. He already has a rule set up that moves the messages from his inbox to another Outlook folder. What Jeferson wants is a solution that is triggered each time a new message is added to that folder. Each time a message is added the solution should parse it and insert portions into an existing Excel spreadsheet. The messages are in plain-text format. Most of the data he wants from each message is in the header (e.g From, To). Two of the fields he wants are lines in the message’s body. The spreadsheet has six columns. Here’s how he wants those columns populated:

• Put the message sender’s name in column A
• Put the date/time the message was sent in column B
• Put the message recipient’s name in column C
• Put the message subject in column D
• Put the first line extracted from the message body into column E
• Put the second line extracted from the message body into column F

Each message processed must add a new line to the spreadsheet. The spreadsheet already exists, so the solution does not need to create one.

With the exception of extracting the correct two lines from the message body, the code for doing this is very simple. I’ve used most of it before in other posts. All that’s required is a routine that monitors the target folder and runs a process each time an item is added. We do this by trapping the ItemAdd event of the target folder’s Items collection. When that event fires we’ll run a routine that opens the Excel spreadsheet, finds the two lines we need from the body, adds a new row to the spreadsheet, and populates the columns as described above. Very straightforward. The only issues is identifying the correct two lines to extract from the body. Jeferson sent me several sample messages to test against and from them I learned that the first line always starts with “You received”. That makes it easy to identify. The second line changes from message to message, but it is always the first non-blank line after the first line. Assuming that the message format doesn’t deviate from those two rules, then we should be in business.

I put the code together and tested using the sample message Jeferson sent. Everything appears to be working correctly. Here then is the code and instructions for adding it to Outlook. Of course Jeferson, and anyone else who reads this post and wants to use the code, should test this thoroughly to make sure it is working properly before using it in a production environment.

This solution will work with Office 2007 and 2010. With modifications it could work in older versions of Office.

The code for this solution comes in two parts.

Part 1.

Follow these instructions to add this part to Outlook.

1. Start Outlook
2. Press ALT+F11 to open the VB editor
3. If not already expanded, expand Microsoft Office Outlook Objects
4. Right-click on Class Modules, select Insert > Class Module
5. In the Properties panel click on Name and enter clsSendDataToExcel
6. Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
7. Edit the code as needed. I included comments wherever something needs to or can change
8. Click the diskette icon on the toolbar to save the changes

'On the next line edit the path to the Excel workbook as needed.
Const WKB_PATH = "H:\General_Expenses_FUP.xlsx"
'On the next line edit the path to the Outlook folder as needed.  This is the folder you want to monitor.
Const FLD_PATH = "Mailbox - Santos Jeferson\COMPRAS\ITAU"

Private WithEvents olkFld As Outlook.Items

Private Sub Class_Initialize()
    Set olkFld = OpenOutlookFolder(FLD_PATH).Items
End Sub

Private Sub Class_Terminate()
    Set olkFld = Nothing
End Sub

Private Sub olkFld_ItemAdd(ByVal Item As Object)
    Dim excApp As Object, _
        excWkb As Object, _
        excWks As Object, _
        lngRow As Long, _
        arrLines As Variant, _
        varLine As Variant, _
        strLine1 As String, _
        strLine2 As String
    If Item.Class = olMail Then
        Set excApp = CreateObject("Excel.Application")
        Set excWkb = excApp.Workbooks.Open(WKB_PATH)
        Set excWks = excWkb.Worksheets(1)
        With Item
            arrLines = Split(.Body, vbCrLf)
            For lngRow = LBound(arrLines) To UBound(arrLines)
                varLine = arrLines(lngRow)
                If varLine <> "" Then
                    If strLine1 = "" Then
                        If Left(varLine, 12) = "You received" Then
                            strLine1 = CStr(varLine)
                        End If
                    Else
                        If strLine2 = "" Then
                            strLine2 = CStr(varLine)
                            Exit For
                        End If
                    End If
                End If
            Next
            lngRow = excWks.UsedRange.Rows.Count + 2
            excWks.Cells(lngRow, 1) = .SenderName
            excWks.Cells(lngRow, 2) = .SentOn
            excWks.Cells(lngRow, 3) = .To
            excWks.Cells(lngRow, 4) = .Subject
            excWks.Cells(lngRow, 5) = strLine1
            excWks.Cells(lngRow, 6) = strLine2
        End With
        excWkb.Close True
        Set excWks = Nothing
        Set excWkb = Nothing
        excApp.Quit
        Set excApp = Nothing
    End If
End Sub

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

Part 2.

Follow these instructions to add this part to Outlook.

Outlook 2007.

1. If not already expanded, expand Microsoft Office Outlook Objects and click on ThisOutlookSession
2. Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
3. Click the diskette icon on the toolbar to save the changes
4. Close the VB Editor
5. Click Tools > Trust Center
6. Click Macro Security
7. Set Macro Security to “Warnings for all macros”
8. Click OK
9. Close Outlook
10. Start Outlook. Outlook will display a dialog-box warning that ThisOutlookSession contains macros and asking if you want to allow them to run. Say yes.

Outlook 2010.

1. If not already expanded, expand Microsoft Office Outlook Objects and click on ThisOutlookSession
2. Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
3. Click the diskette icon on the toolbar to save the changes
4. Close the VB Editor
5. Click File and select Options
6. When the Outlook Options dialog appears click Trust Center then click the Trust Center Settings button
7. Click Macro Settings
8. Select either of the two bottom settings (i.e. “Notifications for all macros” or “Enable all macros (not recommended; potentially dangerous code can run)”. The choice of which to chose is up to you. If you select “Notifications”, then you’ll be prompted at times to enable macros. If you pick “Enable all” then there’s a chance that a malicious macro could run. It’s a question of how much risk you want to assume.
9. Click Ok until the dialog-boxes have all closed
10. Close Outlook
11. Start Outlook. Outlook will display a dialog-box warning that ThisOutlookSession contains macros and asking if you want to allow them to run. Say yes.

Dim objSDTE As clsSendDataToExcel

Private Sub Application_Quit()
    Set objSDTE = Nothing
End Sub

Private Sub Application_Startup()
    Set objSDTE = New clsSendDataToExcel
End Sub