根据ReceivedTime将项目移动到Outlook内的指定子文件夹 [英] Move items to a specified subfolder inside Outlook based on ReceivedTime

问题描述

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

I'm trying to move Outlook Items, However the code runs with no error messages but no emails are moved.

这使我相信必需的 IF条件永远不会被满足？但是我可能错了

This leads me to belief the necessary IF condition is never being met? However I could be wrong.

请在下面找到代码。

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

推荐答案

使用 对于每个... Next Loop 当您正在移动/删除或修改收集项目

使用 For ... Next Statement - 向下循环：

For i = Items.Count to 1 step -1

Next

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

$ b另外请记住除 对象。 aspxrel =nofollow noreferrer> MailItem ，请检查 如果Items.Class = olMail Then ，或者您将遇到错误，循环

Also remember there are objects other than MailItem in your Inbox so check If Items.Class = olMail Then or you will encounter and error on your loop

您也可以使用 Items.Restrict方法（Outlook） 以改善循环

<sub>Items.Restrict方法 在项目中应用过滤器收集，返回一个新的集合，其中包含与过滤器匹配的原始内容的所有项目。

该方法是使用 查找方法 或 FindNext方法 来迭代集合中的特定项目。如果有少量项目，则 Find或FindNext方法比过滤更快。如果集合中有大量项目，则Restrict方法将显着加快，特别是如果预期只能找到大型集合中的少数项目。</sub>
_

_{Items.Restrict Method Applies a filter to the Items collection, returning a new collection containing all of the items from the original that match the filter.
The method is an alternative to using the Find method or FindNext method to iterate over specific items within a collection. The Find or FindNext methods are faster than filtering if there are a small number of items. The Restrict method is significantly faster if there is a large number of items in the collection, especially if only a few items in a large collection are expected to be found.} _

代码示例

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:00 PM <一个href =https://msdn.microsoft.com/en-us/library/ch47ss2a.aspx =nofollow noreferrer> CStr（Date - 1） =（今天 - 1天）

Make sure to set your Filter correctly, I'm assuming your looking at yesterdays 06:00PM CStr(Date - 1) = (today - 1 day)

CStr和日期

_{日期类型始终包含日期和时间信息。为了类型转换的目的，Visual Basic认为1/1/0001（1年1月1日）为日期的中性值，00:00:00（午夜）为当时的中性值。 CStr在结果字符串中不包括中性值。例如，如果将＃1月1日9：30：00＃转换为字符串，结果为9:30:00 AM;日期信息被抑制。但是，日期信息仍然存在于原始日期值中，可以使用 DatePart 。}

这篇关于根据ReceivedTime将项目移动到Outlook内的指定子文件夹的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！