title: Copy emails from my Sent Folder in Outlook 2010 to an Excel file
body: <p>I need to make a record of some emails I've sent over the last couple years, and to include who they were sent to, the date, and the body of the message. Exporting from Outlook does not carry the date, and for some reason Access won't import data from Outlook on my company computers</p>
  
  <p>I came across this macro to export from Outlook to Excel, most of the information I need, but it pulls from the inbox:
  <a href="http://officetricks.com/outlook-email-download-to-excel/" rel="nofollow">http://officetricks.com/outlook-email-download-to-excel/</a></p>
  
  <p>I searched the Office VBA website for commands to make it export from the Sent Items folder instead of the Inbox, but I kept getting <em>run-time error 438 "Object doesn't support this property or method"</em> at the ReceivedByDate and CC lines (under the For command below). It only happens to my sent emails. I tried moving them to a separate folder and into my Inbox, but the macro fails when it reads emails sent from me.</p>
  
  <pre><code>Sub Mail_to_Excel()
  '
  ' Mail_to_Excel Macro
  ' Copies emails from Outlook to an Excel file
  ' Add Tools-&gt;References-&gt;"Microsoft Outlook nn.n Object Library"
  ' nn.n varies as per our Outlook Installation
      Dim Folder As Outlook.MAPIFolder
      Dim iRow As Integer, oRow As Integer
      Dim MailBoxName As String, Pst_Folder_Name  As String
  
      'Mailbox or PST Main Folder Name (As how it is displayed in your Outlook Session)
      MailBoxName = "MyName@Company.com"
  
      'Mailbox Folder or PST Folder Name (As how it is displayed in your Outlook Session)
      Pst_Folder_Name = "Sent Items"
  
      Set Folder = Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name)
      If Folder = "" Then
          MsgBox "Invalid Data in Input"
          GoTo end_lbl1:
      End If
  
      'Read Through each Mail and export the details to Excel for Email Archival
      ThisWorkbook.Sheets(1).Activate
      Folder.Items.Sort "Received"
  
      'Insert Column Headers
      ThisWorkbook.Sheets(1).Cells(1, 1) = "Sent to"
      ThisWorkbook.Sheets(1).Cells(1, 2) = "Copied"
      ThisWorkbook.Sheets(1).Cells(1, 3) = "Subject"
      ThisWorkbook.Sheets(1).Cells(1, 4) = "Date"
      ThisWorkbook.Sheets(1).Cells(1, 5) = "Size"
      ThisWorkbook.Sheets(1).Cells(1, 6) = "Body"
  
      'Insert Mail Data
      For iRow = 1 To 5
      'Folder.Items.Count
          oRow = iRow + 1
          ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
          ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).ReceivedByName
          ThisWorkbook.Sheets(1).Cells(oRow, 2) = Folder.Items.Item(iRow).CC
          ThisWorkbook.Sheets(1).Cells(oRow, 3) = Folder.Items.Item(iRow).Subject
          ThisWorkbook.Sheets(1).Cells(oRow, 4) = Folder.Items.Item(iRow).ReceivedTime
          ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).Size
          ThisWorkbook.Sheets(1).Cells(iRow, 6) = Folder.Items.Item(iRow).Body
      Next iRow
  
      MsgBox "Outlook Mails Extracted to Excel"
  
  end_lbl1:
  End Sub
  </code></pre>