1

请参阅下面的代码。我编写的子程序应该查看今天收到的所有电子邮件，并且只移动那些主题为“每日统计”的电子邮件。我特意给自己发了两封主题为“每日统计”的电子邮件。收件箱中还有另一封没有适当主题的电子邮件。总共有三封电子邮件。当 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
4

1 回答 1

1

我怀疑你的循环“过早地”退出，因为你的循环每次都递增，并且你同时递减堆栈（ItemsToProcess），所以你自然会跳过大约一半的项目。
为避免这种情况，您可以使用以下方法从顶部循环到底部：

For i = ItemsToProcess.Count To 1 Step -1

并i用作引用 MailItems 的索引。

于 2012-12-10T22:54:21.887 回答