考虑以下 Outlook VBA 脚本:
Sub Macro1() 'Move e-mail messages from "Inbox" folder to "New Applications"
Dim olMapi As NameSpace
Dim olStore As Outlook.Store
Dim olRootFldr As Outlook.Folder
Dim olFldrInbox As Outlook.Folder
Dim olFldrSbmtd As Outlook.Folder
Dim dateMin As Date, dateMax As Date
Dim sFilterDmin As String
Dim sFilterDmax As String
Dim olItm As Object
Dim olEmls As Outlook.Items
Dim olEml As Outlook.MailItem
Dim nApplications as Integer
Set olMapi = Application.GetNamespace("MAPI")
Set olStore = olMapi.Stores("Application Processing Department")
Set olRootFldr = olStore.GetRootFolder
Set olFldrInbox = olRootFldr.Folders("Inbox")
Set olFldrSbmtd = olRootFldr.Folders("Submitted Applications")
dateMax = Date - 5
dateMin = dateMax - 2
sFilterDmin = "[ReceivedTime]>='" & Format(dateMin, "DDDDD HH:NN") & "'"
sFilterDmax = "[ReceivedTime]<='" & Format(dateMax, "DDDDD HH:NN") & "'"
Set olEmls = olFldrInbox.Items.Restrict(sFilterDmin)
If olEmls Is Nothing Then MsgBox "!olEmls1": Exit Sub
Set olEmls = olEmls.Restrict(sFilterDmax)
If olEmls Is Nothing Then MsgBox "!olEmls2": Exit Sub
'MsgBox "olEmls.Count=" & olEmls.Count
nApplications = 0
For Each olItm In olEmls
If TypeOf olItm Is Outlook.MailItem Then
Set olEml = olItm
If Not olEml Is Nothing Then
If Left(UCase(olEml.Subject), 16) = "APPLICATION FOR " Then
olEml.Move olFldrSbmtd.Folders("New Applications")
nApplications = nApplications + 1
End If
Set olEml = Nothing
End If
End If
DoEvents
Next olItm
MsgBox "moved nApplications=" & nApplications
End Sub
当我的收件箱中有 1 条消息,主题以“New Application for ...”开头并运行我的 Macro1() 时,MsgBox 显示“moved nApplications=1”,并且该消息被移动到“New Applications”文件夹如预期。但如果有 2 条消息,那么 MsgBox 仍然显示“moved nApplications=1”,我必须再次运行此宏才能移动第二条消息。
上面的代码中应该更改什么才能强制 Items.Restrict() 方法包含满足给定条件的两条/所有消息?顺便说一句,如果收件箱中有 10 条消息,则第一次运行宏可能会显示“moved nApplications=3”(有时“moved nApplications=4”);第二次调用可能会显示“moved nApplications=2”,但它永远不会显示预期的结果。
那是因为您正在使用
For Each
循环,并且您正在更改正在迭代的集合。使用向下 for
循环
for i= olEmls.Count to 1 step -1
set olItm = olEmls(i)