我正在尝试循环访问Outlook中的特定文件夹，并对收件箱子文件夹中的每封电子邮件执行以下操作：
(1)将每封电子邮件中的每个附件保存到特定位置//大多数电子邮件只有1（2）将电子邮件移动到特定的子文件夹
下面的代码工作得很好，除了它不处理1封电子邮件。如果文件夹中有3封电子邮件，它处理2封，留下最后一封。
我不知道这是怎么回事。下面是我使用的代码：
Dim OlApp
Dim OlMail
Dim OlItems
Dim Olfolder
Dim OlSubfolder
Dim MyNameSpace
Dim J As Integer
Dim strFolder As String
Dim MyFileName() As String
Dim EmailCount As Integer
Dim X As Integer
Set OlApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set OlApp = CreateObject("Outlook.Application")
End If
strFolder = ""
strFolder = "C:\Temp\MarketPay\"
Set MyNameSpace = Application.GetNamespace("MAPI")
Set Olfolder = MyNameSpace.Folders.Item("Efficiency Tools").Folders.Item("Inbox").Folders.Item("HomePay").Items
Set OlSubfolder = MyNameSpace.Folders("Efficiency Tools").Folders("Inbox").Folders("HomePay").Folders("Completed")
//only used to validate the number of emails in the folder
EmailCount = 0
EmailCount = Olfolder.Count
X = 1
For Each OlMail In Olfolder
DoEvents
For J = 1 To OlMail.Attachments.Count
ReDim Preserve MyFileName(1 To X)
MyFileName(X) = OlMail.Attachments.Item(J)
OlMail.Attachments.Item(J).SaveAsFile strFolder & OlMail.Attachments.Item(J)
OlMail.Attachments.Item(J).SaveAsFile strFolder & OlMail.Attachments.Item(J).FileName
X = X + 1
Next J
OlMail.Move OlSubfolder
Next我不经常使用VBA在Outlook中，所以我怀疑它是我缺少的东西。附件是每天自动生成的csv文件。电子邮件是相同的。唯一的例外是主题行中的日期。
提前感谢您的帮助……
2条答案
按热度按时间axr492tv1#
您不应该在使用枚举器（
for each）循环访问集合的同时还修改它（通过移动消息）。将循环从
向下循环：
8xiog9wr2#
迭代Outlook文件夹中的所有项目并不是一个好主意：
相反，如果您需要查找所有带有附件的项目并遍历它们，则可以使用
Items类的Find/FindNext或Restrict方法。它们允许获取与指定搜索条件对应的项目，例如，要获取带有附件的项目，您可以使用以下搜索字符串：在代码中，我注意到多行代码具有可重复的代码，例如：
如果您已经检索了同一个对象，那么重用它是有意义的。
请注意，SaveAsFile方法接受一个字符串，表示保存附件的位置。因此，您需要确保传递了有效的文件路径：
最后，要从集合中删除或移动项，我建议使用反向for循环，这样索引就可以始终指向集合中的有效项。