Last reviewed on April 17, 2014   —  8 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 .

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.