XL 2016 trier les mails outlook

[Don pépé]

Bonjour,
J'importe mes mail de outlook vers excel depuis excel cela fonctionne très bien sauf une chose, il importe mes mail du plus ancien au plu récent comment je peux faire pour que se soit l'inverse.
pour l'instant je les tries une fois importer mais je voudrais les trier avant l'importation.

Voici mon code:

Sub ImportMail()
Dim Ligne As Integer, i As Variant, NbPj As Integer
Dim xRacine As String, xDateJour
Dim y As Integer, x As Integer, pceJointe As Outlook.Attachment

On Error GoTo Error_Handler

    ImportMailForm.Label1.Caption = "Connexion à outlook"
    Set ObjOutlook = New Outlook.Application
    Set ObjNameSpace = ObjOutlook.GetNamespace("MAPI")
    Set ObjFolderInbox = ObjNameSpace.GetDefaultFolder(olFolderInbox) 'ObjNameSpace.GetDefaultFolder(6)
    Set Ws1 = ThisWorkbook.Sheets("ImportMail")
    ImportMailForm.Label2.Caption = "Connecter a outlook"
'---------------------------------------------------------
    Ligne = 2
    xRacine = ThisWorkbook.Path
    xDateJour = Format(Now, "dd.mm.yyyy")
    CompteurMAil = 0
'---------------------------------------------------------
    Ws1.Range("A2:F65000").ClearContents 'Efface les mails déjà présent
    ImportMailForm.Label3.Caption = "Importation des mails en cours"
    For Each i In ObjFolderInbox.Items
        If i.UnRead = MLus Then 'Unread = true = mail non lus
            Ws1.Cells(Ligne, 1) = i.Subject
            Ws1.Cells(Ligne, 2) = i.SenderEmailAddress
            Ws1.Cells(Ligne, 3) = i.CreationTime
            Ws1.Cells(Ligne, 4) = Replace(i.Body, Chr(13), "")
            Ws1.Rows(Ligne & ":" & Ligne).RowHeight = 15
            NbPj = i.Attachments.Count
            If NbPj > 0 Then
                'Vérifis si le dossier existe pour le mail expéditeur pièce jointe
                If DossierExiste(xRacine & "\Pj\" & i.SenderEmailAddress & "\") = False Then
                    CreerDossier (xRacine & "\Pj\" & i.SenderEmailAddress & "\")
                End If
                'Vérifis si le dossie existe pour la date de reception des pièces jointes
                If DossierExiste(xRacine & "\Pj\" & i.SenderEmailAddress & "\" & xDateJour & "\") = False Then
                    CreerDossier (xRacine & "\Pj\" & i.SenderEmailAddress & "\" & xDateJour & "\")
                End If
                For y = 1 To i.Attachments.Count
                     Set pceJointe = i.Attachments(y)
                     x = x + 1
                     pceJointe.SaveAsFile xRacine & "\Pj\" & i.SenderEmailAddress & "\" & xDateJour & "\" & x & "_" & pceJointe
                Next y
                Ws1.Cells(Ligne, 5) = NbPj
                Ws1.Cells(Ligne, 6) = xRacine & "\Pj\" & i.SenderEmailAddress & "\" & xDateJour & "\"
            Else
                Ws1.Cells(Ligne, 5) = ""
            End If
            Ligne = Ligne + 1
           
            If MLus = True Then i.UnRead = False 'met les mail en lu
            CompteurMAil = CompteurMAil + 1
            DoEvents
            ImportMailForm.Label0.Caption = CompteurMAil
            If bActiver = False Then
                ImportMailForm.Label4.Caption = "Importation annuler"
                Exit Sub
            End If
        End If
    Next i
   
    Ws1.Sort.SortFields.Add Key:=Range("C2:C65000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With Ws1.Sort
        .SetRange Range("A1:F65000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Ligne = Ligne - 2
    If MLus = True Then
        If Ligne > 1 Then: MsgBox Ligne & " mails non lus importer": Else: MsgBox Ligne & " mail non lus importer"
    Else
        If Ligne > 1 Then: MsgBox Ligne & " mails importer": Else: MsgBox Ligne & " mail importer"
    End If
    ImportMailForm.ToggleButton1.Caption = "Import les mails"
    ImportMailForm.ToggleButton1.Value = False
    ImportMailForm.Label4.Caption = "Importation terminer"
    ObjOutlook.Quit

    Set ObjOutlook = Nothing
    Set ObjNameSpace = Nothing
    Set ObjFolderInbox = Nothing
    Set Ws1 = Nothing
    Set pceJointe = Nothing
    Exit Sub
   
Error_Handler:
MsgBox "MS Excel a généré l'erreur suivante :" & vbCrLf & vbCrLf & _
    "Numéro d'erreur : " & Err.Number & vbCrLf & _
    "Source d'erreur : ImportMail" & vbCrLf & _
    "Description de l'erreur : " & Err.Description, vbCritical, "Une erreur s'est produite!"
    Resume Next
End Sub

Merci pour vôtre aide