CODEWITHSUNDEEP
excelvbaoutlook
user1043870
user1043870

Reputation: 49

Email data exported to Excel - Sort by Received Date

I am writting a macro to export email data to excel file for monthly report.

However I have realised that the data being pulled out is not accordingly to dates; all jumbled up.

Some mailboxes have tons of emails
Hence taking efficiency issue in consideration, is there any way to get the data in latest to oldest order?

Below is part of the code:

Dim msg As Outlook.MailItem
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itm As Object

'Select export folder
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder

'Open and activate Excel workbook.
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate
appExcel.Application.Visible = True

'Copy field items in mail folder.
 For Each itm In fld.Items
'Check item type
If TypeName(itm) = "MailItem" Then
intColumnCounter = 1
Set msg = itm
intRowCounter = intRowCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.To
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.SenderName
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.Subject
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.ReceivedTime
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = GetLastVerb(msg)
End If
Next

Upvotes: 1

Views: 3471

Answers (1)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66215

You need to sort the Items collection first:

set Items = fld.Items
Items.Sort "ReceivedTime", true
For Each itm In Items
  ...

Upvotes: 5

Related Questions