How do I create a macro to move the oldest 20 emails from the bottom of my inbox to another folder in outlook?

Question

I'm trying to move the bottom 20 emails to another folder in Outlook to another folder where the macro runs. I'm able to move then when selected but I don't want to have to select 20 from the bottom (oldest) first. I'd like to automate this bit too.

Any help would be appreciated.

Here's what I have so far but it moves the most recent mail only, regardless of how the inbox is sorted:

Public Sub Move_Inbox_Emails()

Dim outApp As Object
Dim outNS As Object
Dim inboxFolder As Object
Dim destFolder As Object
Dim outEmail As Object
Dim inboxItems As Object
Dim i As Integer
Dim inputNumber As String
Dim numberToMove As Integer



inputNumber = InputBox("Enter number of emails to move")
On Error Resume Next
numberToMove = CInt(inputNumber)
On Error GoTo 0
If numberToMove < 1 Then Exit Sub

Set outApp = CreateObject("Outlook.Application")
Set outNS = outApp.GetNamespace("MAPI")
Set inboxFolder = outNS.GetDefaultFolder(olFolderInbox)
Set destFolder = inboxFolder.Parent.Folders("Mobus")             'Test folder at same level as Inbox

'Sort Inbox items by Received Time

Set itemsCol = inboxFolder.Items
itemsCol.Sort "[ReceivedTime]", False

'Loop through sorted items for the number entered by the user, up to the number of items in the Inbox

For i = inboxFolder.Items.Count To inboxFolder.Items.Count - numberToMove + 1 Step -1
    If inboxFolder.Items(i).Class = OlObjectClass.olMail Then
        Set outEmail = inboxFolder.Items(i)
        'Debug.Print outEmail.ReceivedTime, outEmail.subject
        outEmail.Move destFolder
        End If
Next
End Sub

I've solved this now with some ideas from the commentors, thanks very much. This code now prompts for how many to move and takes them from the oldest first:

Public Sub Move_Inbox_Emails_From_Excel()

Dim outApp As Object
Dim outNS As Object
Dim inboxFolder As Object
Dim destFolder As Object
Dim outEmail As Object
Dim inboxItems As Object
Dim i As Integer
Dim inputNumber As String
Dim numberToMove As Integer

inputNumber = InputBox("Enter number of emails to move")
On Error Resume Next
numberToMove = CInt(inputNumber)
On Error GoTo 0
If numberToMove < 1 Then Exit Sub

Set outApp = CreateObject("Outlook.Application")
Set outNS = outApp.GetNamespace("MAPI")
Set inboxFolder = outNS.GetDefaultFolder(olFolderInbox)
Set destFolder = inboxFolder.Parent.Folders("Mobus")             'Test folder at same level as Inbox

'Sort Inbox items by Received Time

Set inboxItems = inboxFolder.Items
'inboxItems.Sort "[ReceivedTime]", False     'ascending order (oldest first)
inboxItems.Sort "[ReceivedTime]", True      'descending order (newest first)

'Loop through sorted items for the number entered by the user, up to the number of items in the Inbox

For i = inboxFolder.Items.Count To inboxFolder.Items.Count - numberToMove + 1 Step -1
    Set outEmail = inboxItems(i)
    'Debug.Print i, outEmail.Subject
    outEmail.Move destFolder
Next
End Sub

Answer 1

按 ReceivedTime 属性对 Items 集合进行排序，循环遍历最后 20 个项目（使用向下循环 - 步骤 -1）并移动这些项目。