How to sort e-mails in Outlook folder

[ThrottleWorks]

Hi,

I am using below mentioned code to export e-mails from a particular folder of Outlook to excel.

How can I sort this particular folder with dates as latest to oldest.
Is it possible to sort e-mails through excel VBA.

Can anyone help me in this please.

Sub Chandoo_Is_Awesome()
Application.ScreenUpdating = False
    Dim appExcel As Excel.Application
   
    Dim rng As Excel.Range
   
    Dim strSheet As String
    Dim strPath As String
   
    Dim intRowCounter As Integer
    Dim intColumnCounter As Integer
   
    Dim msg As Outlook.MailItem
    Dim nms As Outlook.Namespace
    Dim fld As Outlook.MAPIFolder
    Dim itm As Object
   
    Set MacroBook = ThisWorkbook
    Set ScrapSht = MacroBook.Worksheets("Scrap")
    ScrapSht.Cells.Clear
   
    strPath = ThisWorkbook.Path
    strSheet = strPath & strSheet
   
    'Select export folder
    Set nms = Outlook.Application.GetNamespace("MAPI")
    Set fld = nms.PickFolder
 
    'Handle potential errors with Select Folder dialog box.
    If fld Is Nothing Then
            MsgBox "There are no mail messages to export", vbOKOnly, "Error"
            Exit Sub
        ElseIf fld.DefaultItemType <> olMailItem Then
            MsgBox "There are no mail messages to export", vbOKOnly, "Error"
            Exit Sub
        ElseIf fld.Items.Count = 0 Then
            MsgBox "There are no mail messages to export", vbOKOnly, "Error"
            Exit Sub
    End If
 
    'Open and activate Excel workbook.
    MacroBook.Activate
   
    Set appExcel = Excel.Application
    appExcel.Application.Visible = True
   
    MapSht.Range("B1").FormulaR1C1 = "=TODAY()"
    MapSht.Range("B2").FormulaR1C1 = "=WORKDAY(R1C2,-1)"
    MapSht.Range("B3").FormulaR1C1 = "=WORKDAY(R1C2,-2)"
    MapSht.Range("B4").FormulaR1C1 = "=WORKDAY(R1C2,-4)"
   
    MapSht.Range("A2").FormulaR1C1 = "=YEAR(R[-1]C)"
    MapSht.Range("A3").FormulaR1C1 = "=MONTH(R[-2]C)"
    MapSht.Range("A4").FormulaR1C1 = "=DAY(R[-3]C)"
    MapSht.Range("A5").FormulaR1C1 = "=DATE(R[-3]C,R[-2]C,R[-1]C)"
    MapSht.Range("C2").FormulaR1C1 = "=LEFT(R[-1]C,13)=""Yamaha""" 'For checking subject line
   
    Dim MailCount As Long
    MailCount = 0
   
    'Copy field items in mail folder.
    For MailCount = 1 To 500
   
        MapSht.Range("A1").Value = fld.Items(MailCount).ReceivedTime
        MapSht.Range("C1").Value = fld.Items(MailCount).Subject
       
        If MapSht.Range("A5").Value > MapSht.Range("B4").Value Then
            If MapSht.Range("A5").Value <= MapSht.Range("B1").Value Then
                If MapSht.Range("C2").Value = True Then
                    intColumnCounter = 1
                    Set msg = itm
                   
                    intRowCounter = intRowCounter + 1
                    Set rng = ScrapSht.Cells(intRowCounter, intColumnCounter)
                   
                    'Column A E-Mail Body
                    rng.Value = fld.Items(MailCount).Body
                    intColumnCounter = intColumnCounter + 1
                    Set rng = ScrapSht.Cells(intRowCounter, intColumnCounter)
                   
                    'Column B E-Mail Subject
                    rng.Value = fld.Items(MailCount).Subject
                    intColumnCounter = intColumnCounter + 1
                    Set rng = ScrapSht.Cells(intRowCounter, intColumnCounter)
                   
                    'Column C E-Mail received time
                    rng.Value = fld.Items(MailCount).ReceivedTime
                    intColumnCounter = intColumnCounter + 1
                    Set rng = ScrapSht.Cells(intRowCounter, intColumnCounter)
                End If
            End If
        End If
    Next MailCount
    MailCount = 0
 
    Set appExcel = Nothing
   
    Set rng = Nothing
    Set msg = Nothing
    Set nms = Nothing
    Set fld = Nothing
    Set itm = Nothing
   
    Set appExcel = Nothing
   
    Set rng = Nothing
    Set msg = Nothing
    Set nms = Nothing
    Set fld = Nothing
    Set itm = Nothing
Application.ScreenUpdating = True
End Sub

 

[Chihiro]

You can do something like...

Dim olItems as Object
Set olItems = fld.Items
olItems.Sort "ReceivedTime", True

 

[ThrottleWorks]

Thanks a lot @Chihiro sir, will try and revert with details. Have a nice day ahead.

 

[ThrottleWorks]

Good morning @Chihiro sir, the code is working great. Thanks a lot.