Today’s post is another customized Outlook to Excel export, this one for Ricky. Ricky added a comment to the first post on this topic asking if it’s possible to extract several pieces of data from the body of the message and write each piece to a separate column in the spreadsheet. He goes on to explain that the messages he wants to export will each have four pieces of data in the body: name, phone, address, and comments. Each of the four items will be on a separate line in the message, will be preceded by a label denoting what it is, and will be separated from the data itself by a colon. Something like this
Name: John Doe Phone: 123-456-7890 Address: 123 Any Blvd Comments: Herp Derp!
As already noted, Ricky wants each of the custom data items to go in its own column. He wants this data in addition to the standard message details (e.g. subject, sender) the export already provides.
In order to accomplish Ricky’s goals I had to make two changes to the code in the original post. First, in the ExportMessagesToExcel subroutine I added four lines of code (lines 21-24) to write the additional column headers to the spreadsheet. Second, I added a few variable declarations and 28 lines of code (lines 54-77 and 82-85) in the ProcessFolder subroutine to find and extract the custom data from the body of the message, and write it into the spreadsheet.
This solution should solve Ricky’s issue. It does come with some caveats though. If these conditions aren’t met, then the code cannot reliably extract the custom data.
- The labels are case sensitive (e.g. the label must read “Name:” not “name:”.
- The labels must be separated from the data by a colon.
- The data after the label must NOT contain a Return (i.e. a carriage-return line-feed pair). In other words, the comments cannot be multiple lines of text with Returns separating the lines.
Adding the code to Outlook.
- Start Outlook
- Press ALT+F11 to open the Visual Basic Editor
- If not already expanded, expand Microsoft Office Outlook Objects
- If not already expanded, expand Modules
- 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.
- Copy the code from the code snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
- Click the diskette icon on the toolbar to save the changes
- Close the VB Editor
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" .Cells(1, 4) = "Name" .Cells(1, 5) = "Phone" .Cells(1, 6) = "Address" .Cells(1, 7) = "Comments" 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, _ olkSub As Outlook.MAPIFolder, _ intRow As Integer, _ intPos As Integer, _ arrLines As Variant, _ varLine As Variant, _ strName As String, _ strPhone As String, _ strAddress As String, _ strComments As String 'Find the last line in the worksheet and add 1 to it to get to a new line 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 'Clear the custom data variables strName = "" strPhone = "" strAddress = "" strComments = "" 'Extract custom data from the body of the message arrLines = Split(olkMsg.Body, vbCrLf) For Each varLine In arrLines intPos = InStr(1, varLine, ":") If intPos > 0 Then If Left(varLine, intPos) = "Name:" Then strName = Trim(Mid(varLine, intPos + 1)) End If If Left(varLine, intPos) = "Phone:" Then strPhone = Trim(Mid(varLine, intPos + 1)) End If If Left(varLine, intPos) = "Address:" Then strAddress = Trim(Mid(varLine, intPos + 1)) End If If Left(varLine, intPos) = "Comments:" Then strComments = Trim(Mid(varLine, intPos + 1)) End If End If Next '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) excWks.Cells(intRow, 4) = strName excWks.Cells(intRow, 5) = strPhone excWks.Cells(intRow, 6) = strAddress excWks.Cells(intRow, 7) = strComments intRow = intRow + 1 intMessages = intMessages + 1 End If Next Set olkMsg = Nothing For Each olkSub In olkFld.Folders ProcessFolder olkSub Next Set olkssub = 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.
- With Outlook open select a folder that contains emails.
- Run the macro.
- When prompted enter a filename to save the export to. You can cancel the export by not entering anything.
- The macro will display a dialog-box when it’s finished. The dialog-box includes a count of the number of messages exported.