Question

我试图移动Outlook项目，但代码运行时没有错误消息，但没有移动电子邮件。

这让我相信永远不会满足必要的IF condition？但是我错了。

请在下面找到代码。

Sub Gatekeeper()
    Dim aItem As Object
    Dim mail As Object
    Dim strTime As String
    Dim Items As Outlook.Items
    Dim olNs As Outlook.NameSpace
    Dim subfolder As Outlook.MAPIFolder

    Set olNs = Application.GetNamespace("MAPI")
    Set mail = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = mail.Items

    For Each aItem In Items
        strTime = aItem.ReceivedTime

        If strTime > #6:00:00 PM# And strTime < #5:30:00 AM# Then
            Set subfolder = mail.Folders("Nights")
            aItem.Move subfolder
        End If

    Next aItem
End Sub

Answer 1

移动/删除或修改收藏项目时，您不应该使用 For Each ... Next Loop

_{如果要为集合或数组的每个元素重复一组语句，请使用For Each ... Next循环。}

使用 For ... Next Statement - Down for loop：

For i = Items.Count to 1 step -1

Next

_{当您可以将循环的每个迭代与控制变量相关联并确定该变量的初始值和最终值时， For...Next Statement 效果很好。但是，当您处理集合时，初始值和最终值的概念并不重要，并且您不必知道集合具有多少元素。在这种情况下， For Each...Next loop 通常是更好的选择。}

还要记住收件箱中除 MailItem 以外的对象，请检查 If Items.Class = olMail Then 或您将在循环中遇到并出现错误

您可能还想使用 Items.Restrict Method (Outlook) 来改善循环

_{Items.Restrict Method 对Items集合应用过滤器，返回一个新集合，其中包含原始中与过滤器匹配的所有项目。

  该方法是使用 Find method 或 FindNext method 来迭代集合中特定项目的替代方法。如果项目数量较少， Find或FindNext方法比过滤更快。如果集合中有大量项目，则Restrict方法会明显加快，特别是如果预计只能找到大集合中的少数项目。}   _

代码示例

Option Explicit
Public Sub Example()
    Dim olNs As Outlook.NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim Items As Outlook.Items
    Dim Item As Object
    Dim Filter As String
    Dim i As Long

    Filter = "[ReceivedTime] >= '" & _
              CStr(Date - 1) & _
             " 06:00PM' AND [ReceivedTime] < '" & _
              CStr(Date) & " 05:30AM'"

    Debug.Print Filter

    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items.Restrict(Filter)
        Items.Sort "[ReceivedTime]"

    For i = Items.Count To 1 Step -1
        DoEvents
        If TypeOf Items(i) Is MailItem Then
            Debug.Print Items(i) ' Print on Immediate Window (Ctrl+G)
            Set Item = Items(i)
            Item.Move Inbox.Folders("Nights")
        End If
    Next
End Sub

请务必正确设置过滤器，我假设您正在查看昨天 06:00PM CStr(Date - 1) =（今天 - 1天）

<强> CStr and Date

_{日期类型始终包含日期和时间信息。出于类型转换的目的，Visual Basic将1/1/0001（第1年的1月1日）视为日期的中性值，并将00:00:00（午夜）视为该时间的中性值。 CStr在结果字符串中不包含中性值。例如，如果您将#January 1,0001 9：30：00＃转换为字符串，则结果为＆＃34; 9：30：00 AM＆＃34 ;;日期信息被抑制。但是，日期信息仍然存在于原始日期值中，可以使用 DatePart 等功能恢复。}

Answer 2

不是迭代文件夹中的所有项目，而是需要查找与您的条件相对应的项目，并通过调用Move方法将它们移动到子文件夹（或任何其他文件夹）。

您需要使用Items类的Find / FindNext或Restrict方法查找与您的条件（读取和发件人姓名）对应的所有项目。请阅读以下文章中有关这些方法的更多信息：

How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder

然后，您可以使用MailItem类的Move方法将Microsoft Outlook项目移动到新文件夹。例如：

Sub MoveItems() 
 Dim myNameSpace As Outlook.NameSpace 
 Dim myInbox As Outlook.Folder 
 Dim myDestFolder As Outlook.Folder 
 Dim myItems As Outlook.Items 
 Dim myItem As Object 
 Dim searchCriteria As String

 Set myNameSpace = Application.GetNamespace("MAPI") 
 Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox) 
 Set myItems = myInbox.Items 
 Set myDestFolder = myInbox.Folders("Personal Mail") 
 Set searchCriteria = "[ReceivedTime] >= '" & CStr(Date - 1) & " 06:00PM' AND [ReceivedTime] < '" & CStr(Date) & " 05:30AM'"
 Set myItem = myItems.Find(searchCriteria) 
 While TypeName(myItem) <> "Nothing" 
  myItem.Move myDestFolder 
  Set myItem = myItems.FindNext 
 Wend 
End Sub

您可能会发现Getting Started with VBA in Outlook 2010文章很有帮助。

根据ReceivedTime将项目移动到Outlook中的指定子文件夹

2 个答案: