Hi P45cal,

below is the code that I am working by using web links provided by you

however I need to alter this code retreive only last five days data including current data and also I need to mention the email accounts that this code to look in (as of now it pull all mailboxes, which is not required)and this should download only Inbox and Sent Items not any other folders

kindly help me

[VBA]

' Requires reference to Outlook library
'
Public Sub ListOutlookFolders()

Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim rngOutput As Range
Dim lngCol As Long
Dim olItem As Outlook.MailItem

Set rngOutput = ActiveSheet.Range("A1")

Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")

For Each olFolder In olNamespace.Folders
rngOutput = olFolder.Name
rngOutput.Offset(0, 1) = olFolder.Description
Set rngOutput = rngOutput.Offset(1)
For Each olItem In olFolder.Items
If olItem.Class = olMail Then
Set rngOutput = rngOutput.Offset(1)
With rngOutput
.Offset(0, 1) = olItem.SenderName ' Sender
.Offset(0, 2) = olItem.Subject ' Subject
.Offset(0, 3) = olItem.ReceivedTime ' Received
.Offset(0, 4) = olItem.ReceivedByName ' Recepient
.Offset(0, 5) = olItem.UnRead ' Unread?
.Offset(0, 6) = olItem.ReplyRecipientNames '
.Offset(0, 7) = olItem.SentOn
End With
End If
Next

Set rngOutput = ListFolders(olFolder, 1, rngOutput)
Next

Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing

End Sub
Function ListFolders(myFolder As Outlook.MAPIFolder, Level As Integer, Output As Range) As Range
'
'
'
Dim olFolder As Outlook.MAPIFolder
Dim olItem As Outlook.MailItem
Dim lngCol As Long

For Each olFolder In myFolder.Folders
lngCol = ((Level - 1) * 8) + 1
Output.Offset(0, lngCol) = olFolder.Name
Set Output = Output.Offset(1)
If olFolder.DefaultItemType = olMailItem Then
For Each olItem In olFolder.Items
If olItem.Class = olMail Then
With Output
.Offset(0, lngCol + 1) = olItem.SenderName ' Sender
.Offset(0, lngCol + 2) = olItem.Subject ' Subject
.Offset(0, lngCol + 3) = olItem.ReceivedTime ' Received
.Offset(0, lngCol + 4) = olItem.ReceivedByName ' Recepient
.Offset(0, lngCol + 5) = olItem.UnRead ' Unread?
.Offset(0, lngCol + 6) = olItem.ReplyRecipientNames '
.Offset(0, lngCol + 7) = olItem.SentOn

End With
Set Output = Output.Offset(1)
End If
Next
End If
If olFolder.Folders.Count > 0 Then
Set Output = ListFolders(olFolder, Level + 1, Output)
End If
Next
Set ListFolders = Output.Offset(1)

End Function
[/VBA]