如何创建宏以将最旧的 20 封电子邮件从收件箱底部移动到 Outlook 中的另一个文件夹？

Question

我正在尝试将底部的 20 封电子邮件移动到 Outlook 中的另一个文件夹到另一个运行宏的文件夹中。 我可以在选择时移动，但我不想首先从底部（最旧的）中选择 20。 我也想自动化这一点。

任何帮助，将不胜感激。

这是我到目前为止所拥有的，但它只移动最近的邮件，不管收件箱是如何排序的：

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

我现在已经根据评论者的一些想法解决了这个问题，非常感谢。 此代码现在提示移动多少，并从最旧的开始：

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）并移动这些项目。