Question

我经常需要将相当数量的电子邮件（150+）从子文件夹移动到另一个子文件夹。邮箱中有许多文件夹，我执行此任务。它似乎是一个简单的宏写入，但我所拥有的比使用Ctrl + A慢得多，拖动到目标文件夹。

我之前已经回顾了有关移动Outlook电子邮件和Microsoft的文档的问题，但我无法弄清楚如何以快速可靠的方式完成电子邮件的移动。我会很感激有关我出错的地方以及除了VBA之外还有其他解决方案的信息。

我目前的代码如下。我的最终目标是遍历文件夹名称列表（而不是我选择文件夹）。

提前致谢。

Sub MoveEmailsToDone()

On Error Resume Next

Dim ns As Outlook.NameSpace
Dim AnalystFolder As Outlook.MAPIFolder
Dim MoveToFolder As Outlook.MAPIFolder

Set ns = Application.GetNamespace("MAPI")

Set AnalystFolder = Application.ActiveExplorer.CurrentFolder
Set MoveToFolder = ns.Folders("username@domain.com").Folders(AnalystFolder.Name & "-DONE")

For i = AnalystFolder.Items.Count To 1 Step -1
    AnalystFolder.Items(i).Move MoveToFolder
Next i

Set ns = Nothing
Set AnalystFolder = Nothing
Set MoveToFolder = Nothing

End Sub

Answer 1

根据经验，移动和删除速度很慢。

http://computer-programming-forum.com/1-vba/17216b85e9c096d3.htm

2003年7月7日
以下代码循环遍历指定文件夹中的每个邮件项并将项目移动到另一个文件夹。 1100件商品需要更多超过5分钟。当我选择全部并移入时，它不会移动那么慢用户界面。

。

Outlook使用扩展MAPI来实现移动操作，即
  IMAPIFolder :: CopyMessages（），它采用一个入口列表，因此它没有   需要打开每条消息。商店提供商完成了整个操作   服务器没有来回发送大量数据，显然发生在   你运行你的代码。

Dmitry Streblechenko

https://stackoverflow.com/users/332059/dmitry-streblechenko

DoEvents允许您在代码运行时使用Outlook。

For i = AnalystFolder.Items.Count To 1 Step -1

    DoEvents    
    AnalystFolder.Items(i).Move MoveToFolder      

Next i

MsgBox "MoveEmailsToDone is finally done."

Outlook VBA - 在子文件夹之间批量移动电子邮件

1 个答案: