我正在尝试循环访问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循环,这样索引就可以始终指向集合中的有效项。