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

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

1 个答案: