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

Script for retrieving emails from Outlook

这是我用于从 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

不要将 "for each" 用于您正在更改的集合 - 受限集合是动态的,当您将消息标记为已读时,集合会发生变化。使用向下 "for" 循环:

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