用于从Outlook中检索电子邮件的脚本

Question

这是用于从Outlook收件箱检索电子邮件并存储其附件的脚本。

问题是无法正常工作。它能够从未读电子邮件中收集附件并将它们存储到SavePath中，但不知何故，它在阅读三封电子邮件时正在停止。

奇怪的是，它能够在再次执行时收集剩余的电子邮件，但不是所有剩余的未读电子邮件。

例如：我在收件箱中有6封未读电子邮件，第一次只执行3封电子邮件并收集其附件。第二次执行时，它会读取下2封电子邮件。第三次执行时，剩下的电子邮件被读取。

我无法弄清楚发生了什么，为什么不是所有的电子邮件一次被读取。

Dim SavePath 
Dim Subject 
Dim FileExtension 

SavePath = "C:\IN\" 
Subject = "'Transfer File'" 
FileExtension = "ARmessage" 

Set objOutlook = CreateObject("Outlook.Application") 
Set objNamespace = objOutlook.GetNamespace("MAPI") 
Set objFolder = objNamespace.GetDefaultFolder(6) 'Inbox 

Set colItems = objFolder.Items 
Set colFilteredItems = colItems.Restrict("[Unread]=true") 
Set colFilteredItems = colFilteredItems.Restrict("[Subject] = " & Subject) 

For Each objMessage In colFilteredItems 
    intCount = objMessage.Attachments.Count 
    If intCount > 0 Then 
     For i = 1 To intCount 
      ' if right(Ucase(objMessage.Attachments.Item(i)),9) = FileExtension then 
       objMessage.Attachments.Item(i).SaveAsFile SavePath & _ 
        objMessage.Attachments.Item(i).FileName 
      ' End If 
     Next 
     objMessage.Unread = False 
    End If 
Next 

Answer 1

不要使用“每个”与您正在改变的集合 - 限制集合是动态的，当你标记的邮件阅读，收集的变化。使用向下“for”循环：

dim k 
For k = colFilteredItems.Count to 1 step -1 
    set objMessage = colFilteredItems.Item(k) 
    ... 
next