Skip to content

Instantly share code, notes, and snippets.

@DataSolveProblems
Last active April 8, 2019 09:43
Show Gist options
  • Save DataSolveProblems/e995cb85330932a1afb7003e4822f703 to your computer and use it in GitHub Desktop.
Save DataSolveProblems/e995cb85330932a1afb7003e4822f703 to your computer and use it in GitHub Desktop.
Sub List_Email_Info()
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim i As Long ' Row tracker
Dim arrHeader As Variant
Dim olNS As NameSpace
Dim olInboxFolder As MAPIFolder
Dim olItems As Items
Dim olMailItem As MailItem
arrHeader = Array("Date Created", "Subject", "Sender's Name", "Unread")
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Add
Set olNS = GetNamespace("MAPI")
Set olInboxFolder = olNS.GetDefaultFolder(olFolderInbox)
Set olItems = olInboxFolder.Items
i = 1
On Error Resume Next
xlWB.Worksheets(1).Range("A1").Resize(1, UBound(arrHeader) + 1).Value = arrHeader
For Each olMailItem In olItems
xlWB.Worksheets(1).Cells(i + 1, "A").Value = olItems(i).CreationTime
xlWB.Worksheets(1).Cells(i + 1, "B").Value = olItems(i).Subject
xlWB.Worksheets(1).Cells(i + 1, "C").Value = olItems(i).SenderName
xlWB.Worksheets(1).Cells(i + 1, "D").Value = olItems(i).UnRead
i = i + 1
Next olMailItem
xlWB.Worksheets(1).Cells.EntireColumn.AutoFit
MsgBox "Export complete.", vbInformation
Set xlWB = Nothing
Set xlApp = Nothing
Set olItems = Nothing
Set olInboxFolder = Nothing
Set olNS = Nothing
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment