移动 Restrict() 方法找到的所有项目

问题描述 投票:0回答:1

考虑以下 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

当我的收件箱中有一封主题以“New Application for ...”开头的消息时,MsgBox 显示“moved nApplications=1”,并且该消息将按预期移动到“New Applications”文件夹。
如果有两条消息,则 MsgBox 仍显示“moved nApplications=1”,我必须再次运行此宏才能移动第二条消息。

上面的代码中应该更改什么才能强制 Items.Restrict() 方法包含满足给定条件的两条/所有消息?顺便说一句,如果收件箱中有 10 条消息,则第一次运行宏可能会显示“moved nApplications=3”(有时“moved nApplications=4”);第二次调用可能会显示“moved nApplications=2”,但它永远不会显示预期的结果。

vba outlook
1个回答
2
投票

那是因为您正在使用

For Each
循环,并且您正在更改正在迭代的集合。使用向下
for
循环

for i= olEmls.Count to 1 step -1
  set olItm = olEmls(i)
© www.soinside.com 2019 - 2024. All rights reserved.