导出到Excel的电子邮件数据 – 按接收datesorting

我正在写一个macros来导出电子邮件数据到Excel文件月度报告。

但是我已经意识到,被取出的数据并不是相应的date, 都混乱了

有些邮箱有大量的电子邮件
因此,考虑效率问题,有没有办法从最新到最旧的订单获取数据?

以下是代码的一部分:

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 

您需要首先对Items集合进行sorting:

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