Question

请参阅下面的代码。我编写的子程序应该查看刚刚进入的所有电子邮件，并仅移动那些主题为“每日统计数据”的电子邮件。我故意给自己发了两封电子邮件，主题是“每日统计数据”。收件箱中还有另一封电子邮件没有相应的主题。总共有三封电子邮件。当Sub MoveHarpStatMail运行时，它只会移动一个主题为“每日统计数据”的电子邮件。另一个似乎被忽略了。我的过滤器字符串有什么问题吗？我在另一个子程序中使用了完全相同的过滤器字符串，它在那里工作得很好，阅读今天发来的所有电子邮件。我想我需要另外一双眼睛指出我出错的地方。

艾伦

Public StatsArchiveFolder As Outlook.Folder
'StatsArchiveFolder is set elsewhere in another subroutine
Public Const SubjectTitle As String = "daily stats"
_______________________________________________

Sub MoveHarpStatMail()

Dim olapp As Outlook.Application
Dim olappns As Outlook.NameSpace
Dim oitem As Object
Dim ItemsToProcess As Outlook.Items
Dim myFolder As MAPIFolder
Dim sFilter As String
Dim tempMailItem As Outlook.MailItem

On Error GoTo LocalErr

'set outlook objects

Set olapp = New Outlook.Application
Set olappns = olapp.GetNamespace("MAPI")
Set myFolder = olappns.GetDefaultFolder(olFolderInbox)
'Filter for only MailItems received today
sFilter = "[ReceivedTime] >= " & AddQuotes(Format(Date, "ddddd"))
Set ItemsToProcess = Session.GetDefaultFolder(olFolderInbox).Items.Restrict(sFilter)

For Each oitem In ItemsToProcess
 If TypeName(oitem) = "MailItem" Then
   Set tempMailItem = oitem
   Debug.Print tempMailItem.Subject
   If CheckSubject(tempMailItem.Subject) Then
     MoveToArchiveFolder tempMailItem
   End If
 End If
Next oitem

ExitProc:
Set olapp = Nothing
Set olappns = Nothing
Set myFolder = Nothing
Set ItemsToProcess = Nothing

Exit Sub

LocalErr:
    If Err.Number <> 0 Then
     Msg = "Sub MoveHarpStatMail" & vbCrLf & "Error # " & Str(Err.Number) & " was generated by " _
         & Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description
     MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
     End If
End Sub

____________________________________________

Private Function AddQuotes(MyText) As String
  AddQuotes = Chr(34) & MyText & Chr(34)
End Function

_______________________________________________

Sub MoveToArchiveFolder(Item As Outlook.MailItem)

    If StatsArchiveFolder Is Nothing Then
      MsgBox ("The ArchiveFolder object is not set.")
    End If

    Item.Move StatsArchiveFolder

End Sub
________________________________________________

Function CheckSubject(Subject As String) As Boolean

  If LCase(Trim(Subject)) = LCase(Trim(SubjectTitle)) Then
    CheckSubject = True
  Else
    CheckSubject = False
  End If

End Function

Answer 1

我怀疑你的循环正在退出＆＃34;过早地＆＃34;因为您每次都会循环增加循环次数，并且您同时递减堆栈（ItemsToProcess），因此您自然会跳过大约一半的项目。<登记/> 为避免这种情况，您可以使用以下内容从顶部到底部循环：

For i = ItemsToProcess.Count To 1 Step -1

并使用i作为引用MailItems的索引。

没有从收件箱中读取所有邮件

1 个答案: