选择特定文件夹中的所有项目并将它们移动到另一个文件夹。

Question

我该如何选择共享账户（不是我的个人账户）中“已删除邮件”文件夹中的所有邮件，然后将其移动到名为“旧邮件”的其他文件夹中。以下是我目前编写的内容：

'Macro for pseudo-archiving
Sub PseudoArchive()
On Error Resume Next

Dim objNamespace As Outlook.NameSpace
Dim sourceFolder As Outlook.MAPIFolder
Dim Messages As Selection
Dim Msg As MailItem

Set objNamespace = GetNamespace("MAPI")
Set sourceFolder = objNamespace.Folders("[e-mail]")
Set sourceFolder = objFolder.Folders("Deleted Items")

'Define path to the target folder
Set destinationFolder = ns.Folders("[e-mail]").Folders("Old Emails")

'Move emails in sourceFolder to destinationFolder
For Each Msg In sourceFolder
    Msg.Move destinationFolder
Next

Set objNamespace = Nothing
Set sourceFolder = Nothing
Set Messages = Nothing
Set Msg = Nothing

End Sub

我在如何让宏选择sourceFolder中的所有项目以便将它们移动到destinationFolder方面遇到了困难。我不想在运行宏之前手动选择文件夹中的电子邮件。

如果有人能提供帮助，那将不胜感激。谢谢！

- jshapy8

Answer 1

你差不多就快成功了，试试下面的方法：

Option Explicit
Sub PseudoArchive()
    Dim objNamespace As Outlook.NameSpace
    Dim sourceFolder As Outlook.MAPIFolder
    Dim destinationFolder As Outlook.MAPIFolder
    Dim Items As Outlook.Items
    Dim Item As Object
    Dim Msg As String
    Dim i As Long

    Set objNamespace = GetNamespace("MAPI")
    Set sourceFolder = objNamespace.Folders("[e-mail]").Folders("Deleted Items")
    Set destinationFolder = objNamespace.Folders("[e-mail]").Folders("Inbox").Folders("Old Emails")
    Set Items = sourceFolder.Items

    'Move emails in sourceFolder to destinationFolder
    Msg = Items.Count & " Items in " & sourceFolder.Name & ", Move?"

    If MsgBox(Msg, vbYesNo) = vbYes Then
        For i = Items.Count To 1 Step -1
            Set Item = Items.Item(i)
            DoEvents
            Item.Move destinationFolder
        Next
    End If

End Sub

- 0m3r

Answer 2

这里有一段代码片段可以帮助你：

以下是代码片段。

Dim olApp As Outlook.Application
Dim olFol As Outlook.Folder, olDestFol As Outlook.Folder
Dim olItem As Object
Dim i as Long, j as Long
Set olApp = New Outlook.Application olApp.GetNamespace("MAPI").Folders("mailboxnamehere").Folders("Deleted Items")
Set olDestFol = olApp.GetNamespace("MAPI").Folders("mailboxnamehere").Folders("Inbox").Folders("Deleted Items") ' Destination Folder
Do Until olFol.Items.Count = 0
    olFol.Items(1).Move olDestFolder
Loop

- Andy Wynn

---

在“for each”循环中不应修改集合。请使用从计数器向下计数到1的循环。 - Dmitry Streblechenko

为什么在 olDestFol 赋值时引用共享邮箱收件箱文件夹而不是 olFol 赋值？ - jshapy8

因为这是从我在另一个关于共享邮箱的答案中准备的代码片段中复制的，但在这种情况下，它将是您的电子邮件地址。 - Andy Wynn

您可能还想避免使用多个点符号表示法 - 在进入循环之前缓存Items集合。 - Dmitry Streblechenko