Download Outlook emails to Excel

Hello Anjil,

What you are requesting requires some high level coding techniques, however, here's a code I created sometime again that may suit you, but you may need to make a few adjustments.

Paste the code into a new excel module and run. enter a start date, then an end date, it will prompt you for an outlook folder, hope it works.

Option Explicit
Dim n As Long
Sub Launch_Pad()

Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim Date1, Date2

Do
'Date1 = Application.InputBox("Enter a date or select the cell with the starting date", "Start Date", , , , , , 10)
Date1 = Application.InputBox("Enter a date or select the cell with the starting date", "Start Date", "=J1", , , , , 10)
If Date1 = False Then Exit Sub
On Error Resume Next
Date1 = CDate(Date1)
On Error GoTo 0
Loop Until IsDate(Date1)
Do
'Date2 = Application.InputBox("Enter a date or select the cell with the ending date", "End Date", , , , , , 10)
Date2 = Application.InputBox("Enter a date or select the cell with the ending date", "End Date", "=K1", , , , , 10)
If Date2 = False Then Exit Sub
On Error Resume Next
Date2 = CDate(Date2)
On Error GoTo 0
Loop Until IsDate(Date2)
'MsgBox Format(Date1, "dd mmm yyyy") & ", " & Format(Date2, "dd mmm yyyy")

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.PickFolder

n = 2
Cells.ClearContents 'if there are start/end dates in any cell on this sheet this command will erase them

Call ProcessFolder(olFolder, Date1, Date2)

Set olNS = Nothing
Set olFolder = Nothing
Set olApp = Nothing
Set olNS = Nothing
End Sub
Sub ProcessFolder(olfdStart As Outlook.MAPIFolder, Date1, Date2)
Dim olFolder As Outlook.MAPIFolder
Dim olObject As Object
Dim olMail As Outlook.MailItem

For Each olObject In olfdStart.Items
If TypeName(olObject) = "MailItem" Then
'Application.StatusBar = olObject.ReceivedTime
'If olObject.SentOn >= Date1 And olObject.SentOn <= Date2 Then
If olObject.ReceivedTime >= Date1 And olObject.ReceivedTime <= Date2 Then
n = n + 1
Set olMail = olObject
Cells(n, 1) = olMail.Subject
If Not olMail.UnRead Then Cells(n, 2) = "Message is read" Else Cells(n, 2) = "Message is unread"
Cells(n, 3) = olMail.ReceivedTime
Cells(n, 4) = olMail.LastModificationTime
Cells(n, 5) = olMail.Categories
Cells(n, 6) = olMail.SenderName
Cells(n, 7) = olMail.FlagRequest
End If
End If
Next
Set olMail = Nothing
Set olFolder = Nothing
Set olObject = Nothing
End Sub


I hope this resolves your question. If it has, please mark this question as resolved.

If you require further assistance, please reply to this post. Or perhaps you have another Microsoft Office question?

Have a great day.
Regards,

Mark
Microsoft Office Specialist Trainer