Last reviewed on July 27, 2015   —  18 Comments

This macro collects the fields from each Outlook message in a selection and writes the values of the fields to an Excel worksheet. It's easily adapted to work with any field and any Outlook item type.

Write Outlook data to a spreadsheet

Option Explicit
 Sub CopyToExcel()
 Dim xlApp As Object
 Dim xlWB As Object
 Dim xlSheet As Object
 Dim rCount As Long
 Dim bXStarted As Boolean
 Dim enviro As String
 Dim strPath As String

 Dim currentExplorer As Explorer
 Dim Selection As Selection
 Dim olItem As Outlook.MailItem
 Dim obj As Object
 Dim strColB, strColC, strColD, strColE, strColF As String
               
' Get Excel set up
enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
 strPath = enviro & "\Documents\test.xlsx"
     On Error Resume Next
     Set xlApp = GetObject(, "Excel.Application")
     If Err <> 0 Then
         Application.StatusBar = "Please wait while Excel source is opened ... "
         Set xlApp = CreateObject("Excel.Application")
         bXStarted = True
     End If
     On Error GoTo 0
     'Open the workbook to input the data
     Set xlWB = xlApp.Workbooks.Open(strPath)
     Set xlSheet = xlWB.Sheets("Test1")
    ' Process the message record
    
    On Error Resume Next
'Find the next empty line of the worksheet
rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row


' get the values from outlook 
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
  For Each obj In Selection

    Set olItem = obj
   
 'collect the fields
    strColB = olItem.SenderName
    strColC = olItem.SenderEmailAddress 
    strColD = olItem.Body
    strColE = olItem.To
    strColF = olItem.ReceivedTime

'write them in the excel sheet
  xlSheet.Range("B" & rCount) = strColB
  xlSheet.Range("c" & rCount) = strColC
  xlSheet.Range("d" & rCount) = strColD
  xlSheet.Range("e" & rCount) = strColE
  xlSheet.Range("f" & rCount) = strColF
 
'Next row
  rCount = rCount + 1

 Next

     xlWB.Close 1
     If bXStarted Then
         xlApp.Quit
     End If
    
     Set olItem = Nothing
     Set obj = Nothing
     Set currentExplorer = Nothing
     Set xlApp = Nothing
     Set xlWB = Nothing
     Set xlSheet = Nothing
 End Sub

How to use macros

First: You will need macro security set to low during testing.

To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.

After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Open the VBA Editor by pressing Alt+F11 on your keyboard.

To put the code in a module:

  1. Right click on Project1 and choose Insert > Module
  2. Copy and paste the macro into the new module.

More information as well as screenshots are at How to use the VBA Editor


Comments

    • Diane PoremskyDiane Poremsky says

      Get the subject:
      strColG = olItem.Subject

      'write them in the excel sheet
      xlSheet.Range("G" & rCount) = strColG

  1. Satej says

    Hello Diane..

    Thanks for the code...It's really useful. However, the formatting of the excel sheet is not good enough. Kindly suggest what could be done to achieve a good formatting.
    Thanks in advance..

    • Diane PoremskyDiane Poremsky says

      You can apply formatting using VBA or, if adding to an existing workbook, the formatting should carry over to each row.

  2. Satej says

    Also, the macro runs only for the emails which are selected. How can I modify it to run on all the emails in the selected Outlook folder?

    Thanks again..

    • Diane PoremskyDiane Poremsky says

      This tells it to run on the selected items:
      Set currentExplorer = Application.ActiveExplorer
      Set Selection = currentExplorer.Selection
      For Each obj In Selection
      Set olItem = obj

      To work with all in the current folder:
      Set objOL = Outlook.Application
      Set objFolder = objOL.ActiveExplorer.CurrentFolder
      Set objItems = objFolder.Items
      For Each obj In objItems
      With obj

      (You'll need to make sure the references are correct. That snippet was copied from http://www.slipstick.com/developer/code-samples/working-items-folder-selected-items/)

  3. himanshu says

    Requirement: I need your help as i am asked to analyse the data of my current mailbox.
    Further more i need to keep the track of mails being replied and missed .Can you tell me the ways to do this ..in excel or in outlook .I have outlook 2010 and 2003 mailbox configured .

  4. James says

    Hi Im just wondering if there is a way using this code to extract the emails from exchange accounts? Im not getting the actual email address for any internal employees.
    Cheers

    • james says

      Or is there a way to extract all the info from the contact cards i have in my outlook?

      Cheers

    • Diane PoremskyDiane Poremsky says

      You can use Outlook Import/Export function to export the contacts. This would be easier than macros because you don't need to add every field to the code.

    • Diane PoremskyDiane Poremsky says

      Yeah, you can get their smtp addresses or aliases, although aliases are messy if using Office 365 Exchange.
      Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E
      Set recips = Item.Recipients
      For Each recip In recips
      Set pa = recip.propertyAccessor
      Address = LCase(pa.GetProperty(PR_SMTP_ADDRESS))

      That sample code is from http://www.slipstick.com/how-to-outlook/prevent-sending-messages-to-wrong-email-address/ - it has all of the dim's you'll need.

  5. Claudia Fernandes says

    Hello,

    Do you know how I can extract the first email reply time from Outlook?
    What I would want to know is how much time it took me to answer each email; Ive found out the last reply time, not the first unfortunately.

    Thank you very much!

    • Diane PoremskyDiane Poremsky says

      Outlook doesn't track the each time your reply, only the last one. If you reply to the same message more than once, you'd need to look at the sent items to get each reply time.

  6. Claudia Fernandes says

    Hello Diane,
    Thank you very much for your fast reply.
    Then can you please let me know how can I compare emails received with the first reply to each on sent? Basically I need to check if me and my colleagues are compliantly replying to all emails within X minutes; do you have any idea how I could do this? I'm running out of ... Because we do user the same inital email to reply orforward several times.
    Once again thank you very much for your help on this.

    • Diane PoremskyDiane Poremsky says

      Are the sent items stored in the same mailbox? If so (and assuming the subject varies) you'll need to export both the inbox and sent folder to Excel then sort by subject (you'll need a way to sort correctly since replies will have RE in the subject.)

  7. CoolAuto says

    Hi Diane,
    Excel 2010 file. Upon open, from Outlook e-mail, I want a macro to grab e-mail address of a recipient to then filter to only his/her items on the spreadsheet of that Excel file. But that CAN'T be just from "To" field of that e-mail, as there are multiple recipients. I can figure out other portions, but need that e-mail address grab portion AND how to have that address be then integrated into the filtering criteria.
    Can you help?

    • Diane PoremskyDiane Poremsky says

      are you checking every address in the to field against the spreadsheet? You'll use the recipient collection -
      This will grab each address, one at a time
      Dim Recipients As Outlook.Recipients
      Dim recip As Outlook.Recipient
      Dim i

      Set Recipients = Item.Recipients
      For i = Recipients.Count To 1 Step -1
      Set recip = Recipients.Item(i)

Leave a Reply

Please post long or more complicated questions at OutlookForums by Slipstick.com.

If the Post Comment button disappears, press your Tab key.