Ricky – Custom Excel Export


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.

  1. The labels are case sensitive (e.g. the label must read “Name:” not “name:”.
  2. The labels must be separated from the data by a colon.
  3. 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.

  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
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.

  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.
Advertisements

43 comments on “Ricky – Custom Excel Export

  1. Hi .. thats what i exactly needed .. but i need just few tweaks .. i need the Excel file to have this data which extracted from email :

    Name: whatever
    Surname: surnameforwhatever
    Email: whatever@hotmail.com
    Phone: 01100000000
    Time: 73-09 (that is included in the email but variable depending on the email label)
    Office: cairo (that is included in the email but variable depending on the email label)

    You will save my life if this works 🙂

    • Hi, Reda Ahmed.

      I miscounted on “Surname”. Please replace your copy of ExportMessagesToExcel with the one below. Leave the rest of the code as is.

      Sub ExportMessagesToExcel()
          Dim olkmsg As Object, _
              excApp As Object, _
              excWkb As Object, _
              excWks As Object, _
              lngRow As Long, _
              lngCnt As Long, _
              intVer As Integer, _
              strFil As String, _
              strTmp As String, _
              arrLns As Variant, _
              varLin As Variant
          strFil = InputBox("Enter a filename (including path) to save the exported messages to.", MACRO_NAME)
          If strFil <> "" Then
              intVer = GetOutlookVersion()
              Set excApp = CreateObject("Excel.Application")
              Set excWkb = excApp.Workbooks.Add()
              Set excWks = excWkb.ActiveSheet
              '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) = "Surname"
                  .Cells(1, 6) = "Email"
                  .Cells(1, 7) = "Phone"
                  .Cells(1, 8) = "Time"
                  .Cells(1, 9) = "Office"
              End With
              lngRow = 2
              'Write messages to spreadsheet
              For Each olkmsg In Application.ActiveExplorer.CurrentFolder.Items
                  'Only export messages, not receipts or appointment requests, etc.
                  If olkmsg.Class = olMail Then
                      'Add a row for each field in the message you want to export
                      excWks.Cells(lngRow, 1) = olkmsg.Subject
                      excWks.Cells(lngRow, 2) = olkmsg.ReceivedTime
                      excWks.Cells(lngRow, 3) = GetSMTPAddress(olkmsg, intVer)
                      arrLns = Split(olkmsg.Body, vbCrLf)
                      For Each varLin In arrLns
                          strTmp = Trim(varLin)
                          If Left(strTmp, 6) = "Name: " Then
                              excWks.Cells(lngRow, 4) = Mid(strTmp, 7)
                          Else
                              If Left(strTmp, 9) = "Surname: " Then
                                  excWks.Cells(lngRow, 5) = Mid(strTmp, 10)
                              Else
                                  If Left(strTmp, 7) = "Email: " Then
                                      excWks.Cells(lngRow, 6) = Mid(strTmp, 8)
                                  Else
                                      If Left(strTmp, 7) = "Phone: " Then
                                          excWks.Cells(lngRow, 7) = Mid(strTmp, 8)
                                      Else
                                          If Left(strTmp, 6) = "Time: " Then
                                              excWks.Cells(lngRow, 8) = Mid(strTmp, 7)
                                          Else
                                              If Left(strTmp, 8) = "Office: " Then
                                                  excWks.Cells(lngRow, 9) = Mid(strTmp, 9)
                                              End If
                                          End If
                                      End If
                                  End If
                              End If
                          End If
                      Next
                      lngRow = lngRow + 1
                      lngCnt = lngCnt + 1
                  End If
              Next
              Set olkmsg = Nothing
              excWks.Columns("A:I").AutoFit
              excWkb.SaveAs strFil
              excWkb.Close
          End If
          Set excWks = Nothing
          Set excWkb = Nothing
          Set excApp = Nothing
          MsgBox "Process complete.  A total of " & lngCnt & " messages were exported.", vbInformation + vbOKOnly, "Export messages to Excel"
      End Sub
      
  2. Thanks for the cod sir
    one problem though:
    Dim olkMsg As Object,-
    excApp As Object, –

    04 excWkb As Object, _
    05
    excWks As Object, _
    06
    intRow As Integer, _
    07
    intVersion As Integer, _
    08
    i get a message box indicating that a variable is required , kindly help

    • Patrick,

      There shouldn’t be any line numbers at the beginning of each line. Please copy the code again without getting the line numbers.

    • thanks sir,
      could you be in a position to advice about how to export some specific set of words appearing randomly in word document(2010) to specified columns in excel?
      ive really researched about this to aid in deriving specific qualifications in a curriculum vitae.to a specific spread sheet in excel..
      thanks in advance.

    • Thanks for the fast reply

      Here is the situation:
      i receive 100 – 200 C Vs as attachments to emails everyday in outlook ,
      here i have to separate them according to the vacancies advertised , then in an excel document summarize them listing :

      1. column for the name and email address
      2.column for qualification listing year, qualification & institution
      3. column for work experience listing year, position and organisation worked for.
      basically it looks like this:

      Name EDUCATION BACKGROUND WORK EXPERIENCE
      Patrick Byte 1999 to 2005 2006 to 2008
      +254705939 Bachelors in commerce Junior Accountant
      info@outrivalhr.com Nairobi university Outrival hr solutions
      2006 to date 2008 to Date
      Bachelors in commerce Senior Accountant
      Nairobi university Nairobi university

      is there a way to automatically extract data from a word document (Randomly placed under titles) to the above format in excel?

    • Patrick,

      The answer is possibly. Assuming that the CV is always a Word document, that format of the documents is always the same or that the data you want always follows a given set of key words or phrases, then yes it should be possible. Getting the data out of Word shouldn’t be a problem. What will be difficult is finding the data. There has to be something to key on. If the documents aren’t formatted the same or don’t use the same key words/phrases, then it’ll be almost impossible to identify each piece of data.

    • 98 % of the cvs come bearing the same keywords

      Education background, work experience,Qualifications ,Name etc.
      if you may ild send you a copy of one for clarity.

  3. Hi David lee,
    thanks for providing for such a great script for automation,
    However I would like to know how can we include the all text (multiline text) in a cell in the above script.
    Regards,
    Arun

    • Hi, Arun.

      Thanks!

      You can get the entire body of the email with something like this

      excWks.Cells(intRow, x) = olkMsg.Body
      

      where “x” is some column number.

    • Hi David,
      Thanks for your prompt response.

      In my last comment I actually needed the entire text from single response.

      Let me explain more clear to you.

      In your example
      1 Name: John Doe
      2 Phone: 123-456-7890
      3 Address: 123 Any Blvd
      4 Comments: Herp Derp!

      In above example all email content is in single line, However what i am facing problem is I am receiving the email format like below and it skip the second and any other line in 3rd “There is another line for address, CA- USA -156423 third line for address” and 4rth point “second line of comment any other line or so.”
      1 Name: John Doe
      2 Phone: 123-456-7890
      3 Address: 123 Any Blvd
      There is another line for address, CA- USA -156423
      third line for address
      4 Comments: Herp Derp!
      second line of comment
      any other line or so.

      So i am looking for the solution which can grab all the content from single point until the another point is strated.
      May be we can keep trace the content between Adress: to Comments:

      I don’t exactly know how it can be done, I will appreciate your work if you can provide solution or highlight anything over it.

    • Hi, Arun.

      I apologize for being so slow. I’m still behind from the holidays in December and trying to catch up.

      Do I remember correctly that you control the format the messages come in and that we can use the format you sent in your last message sans the border? If so, then the code is ready to go.

  4. David please help me! I made the code above working, but I have some wrong output.

    I only want to display parts of the data on my email, here is an examples,

    Case 1:

    Event: Brothers Of The Sun Tour: Kenny Chesney & Tim McGraw Aug 24 2012 4:30PM

    on my ‘EVENT’ column I only need to display “Brothers Of The Sun Tour: Kenny Chesney & Tim McGraw”, then “Aug 24 2012” must display under ‘SHOW DATE’ column. I can just disregard the time though.

    Case 2:

    Section: B5 Row: 13

    under ‘SECTION’ column the only data that must appear on the cell is “B5” but what I have is “B5 Row:13”, and my ‘ROW’ column has no value, which suppose to display “13”

    I’m really sorry for bugging you, I really hope you can help me with my concerns.

    • Hi, Zoi.

      Are you saying that you want to extract everything after the keywords “Event:” and “Section:” from the body of the message?

    • Hi!

      I need to an output like this,

      EVENT: Brothers Of The Sun Tour: Kenny Chesney & Tim McGraw
      SHOW DATE: Aug 24 2012

      but what I have is Brothers Of The Sun Tour: Kenny Chesney & Tim McGraw Aug 24 2012 4:30PM, so, I need to split it.

    • Zoi,

      I need to know exactly how the body is formatted. Also, is this the only message you need to handle or are there others (i.e. something other than “Brother of the Sun Tour”)? If there are others, then unless the portions of text you want are delimited with something, then this is going to be very difficult, if not impossible, to do.

  5. Hi Ricky,

    This is awesome, thanks so much! I’ve been trying to import my Outlook folder into Access, but it turns out that the import wizard silently closes and refuses to do anything. This here is a perfect solution.

    Do you happen to know the function if I want to get the recipients’ email address as well?

    It wouldn’t be Item.SenderEmailAddress but something else?

    I have no idea!

    Thanks!

    • Hi, Jackdaw.

      I’m guessing that you want the address that the message came in through, not the email addresses of everyone the message was sent to. If that’s correct, then assuming that you’re using Outlook 2007 or later you can get that piece of information with this additional bit of code.

      Public Function GetProperty(olkItm As Object, strPropName As String) As Variant
          Dim olkPA As Outlook.PropertyAccessor
          Set olkPA = olkItm.PropertyAccessor
          GetProperty = olkPA.GetProperty(strPropName)
          Set olkPA = Nothing
      End Function
      

      Add that function to the code you already have, then add a line like this wherever you want to get the recipient’s email address.

      'On the next line change x to a column number
      excWks.Cells(intRow,x) = GetProperty(olkMsg, "http://schemas.microsoft.com/mapi/proptag/0x0076001e")
      
    • Thanks David!

      Unfortunately – and this might be an issue with Exchange – the way this function exports the email address is in a link: /O=YP/OU=EXCHANGE ADMINISTRATIVE GROUP (FYDIBOHF32SPDLT)/CN=RECIPIENTS/CN=DE_TRACK8A5

      Do you know how to receive the correct email address from above line?

      That would be very helpful! Thanks!

    • You’re welcome.

      Actually, that is the correct address. It’s just not in the format you were expecting. That address is in X.400 format which is what Exchange uses internally. I’m guessing that you’re looking for an SMTP address instead. Is that correct?

    • Yes, I would need the SMTP address. My coding skills are very basic, but I assume this would require a query to the exchange database to receive the correct format?

    • Add this code to what you already have.

      Function X400toSMTP(strAdr As String) As String
          Dim olkRcp As Outlook.Recipient, olkUsr As Outlook.ExchangeUser
          Set olkRcp = Session.CreateRecipient(strAdr)
          olkRcp.Resolve
          Set olkUsr = olkRcp.AddressEntry.GetExchangeUser
          X400toSMTP = olkUsr.PrimarySmtpAddress
          Set olkRcp = Nothing
          Set olkUsr = Nothing
      End Function
      

      Now, modify the calling code to this

      'On the next line change x to a column number
      excWks.Cells(intRow,x) = X400toSMTP(GetProperty(olkMsg, "http://schemas.microsoft.com/mapi/proptag/0x0076001e"))
      

      This should get you the SMTP address.

    • Thanks so much for your effort!

      Unfortunately it fails at this line (Line 5):

      Set olkUsr = olkRcp.AddressEntry.GetExchangeUser

      Message is:

      Run-time error ‘-1802239729 (9494010f)’:

      The attempted operation failed. And object could not be found.

    • The modified code won’t work for messages that come in from the outside. The senders don’t have accounts on your Exchange server which causes GetExchangeUser to fail. We’re going to have to try adding a conditional statement in there. Change the calling statement from

      'On the next line change x to a column number
      excWks.Cells(intRow,x) = X400toSMTP(GetProperty(olkMsg, "http://schemas.microsoft.com/mapi/proptag/0x0076001e"))
      

      to

      'On the next line change x to a column number
      excWks.Cells(intRow, x) = IIf(olkMsg.Sender.AddressEntryUserType = olSmtpAddressEntry, olkMsg.SenderEmailAddress, X400toSMTP(GetProperty(olkMsg, "http://schemas.microsoft.com/mapi/proptag/0x0076001e")))
      

      This adds a test to see if the sender’s address is an SMTP address. If it is, then there’s no need to run through the process of converting from X400 to SMTP. All messages coming from the outside should be SMTP addresses. If the address is not in SMTP format, then presumably the sender is inside your organization in which case we need to convert from X400 to SMTP.

  6. Hi Ricky, great job. I have just one question.

    I’m using more parameters to an adjusted pretty well, but the problem arises when I get the email address.

    when the destination is my contact. the parameter (olkMsg.To) exports it to excel

    but when it’s not my contact. exports it to the NEXT form:

    this happens only. when I export the sent items.

    I want. I always export the mailto: in the format (Xxxxxx@xxxxx.xxx)

    excWks.Cells (intRow, 1) = olkMsg.Subject
    excWks.Cells (intRow, 2) = olkMsg.ReceivedTime
    excWks.Cells (intRow, 3) = GetSMTPAddress (olkMsg, intVersion)
    excWks.Cells (intRow, 4) = olkMsg.Body
    excWks.Cells (intRow, 5) = olkMsg.SenderEmailAddress
    excWks.Cells (intRow, 5) = olkMsg.To

    $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $

    excWks.Cells (intRow, 5) = olkMsg.To = (mailto:)?????

    thanks for the great contribution.

    Apologies for the translation.

    • Hi, Hanzo51.

      Thanks! I’m glad you like the code.

      I’m not sure I understand what you mean when you say “exports it to the NEXT form”. Can you give me an example? Also, is your mailbox on an Exchange server? If yes, what version of Outlook are you using?

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