从上一个工作日移动电子邮件什么都不做

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了从上一个工作日移动电子邮件什么都不做相关的知识,希望对你有一定的参考价值。

我正在尝试整合Outlook VBA以查找上一个工作日(周一至周五)主要收件箱中的所有电子邮件,并将它们移动到我正在创建的新文件夹中。

我试图添加逻辑以跳过周六和周日。从今天是星期一开始,我应该从周五开始发送所有电子邮件。它成功创建了上周五日期的新文件夹,但它不会移动任何电子邮件。最后我查了一下,周五它确实移动了周四的项目。我很难确定为什么今天上周五的电子邮件不会移动?

我的问题是,任何人都可以确定为什么星期五的电子邮件根本没有被移动?

以下是我目前使用的代码:

Sub Move_Yesterdays_Emails()

'***Creates a new folder named yesterdays date under the inbox***

 Dim myNameSpace As Outlook.NameSpace
 Dim myFolder As Outlook.Folder
 Dim myNewFolder As Outlook.Folder
 Dim xDay As String
 Dim XDate As Date

    If Weekday(Now()) = vbMonday Then
        XDate = Date - 3
    Else
        XDate = Date - 1
    End If

 Set myNameSpace = Application.GetNamespace("MAPI")
 Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
 Set myNewFolder = myFolder.Folders.Add(XDate)

'***Releases memory***

 Set myNameSpace = Nothing
 Set myFolder = Nothing
 Set myNewFolder = Nothing

'***Finds all emails in the inbox from yesterday and moves them to the created folder***

    Dim myNameSpace 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(XDate) & _
             " 12:00AM' AND [ReceivedTime] < '" & _
              CStr(XDate) & " 12:00AM'"

        Debug.Print Filter

    Set myNameSpace = Application.GetNamespace("MAPI")
    Set Inbox = myNameSpace.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)
            Set Item = Items(i)
            Item.Move Inbox.Folders(XDate)
        End If
    Next
End Sub

先感谢您。我今天想解决这个问题,所以我不必等到下周一才能再次尝试这种情况。

答案

你的代码有几个问题,我修复了一切,现在运行正常

主要错误:你的过滤器是

 [ReceivedTime] >= '15/06/2018 12:00AM' AND [ReceivedTime] < '15/06/2018 12:00AM'

所以基本上它没有搜索任何东西,因为它们之间的2个日期时间是相同的。你应该像这样制作你的过滤器

    Filter = "[ReceivedTime] >= '" & _
          CStr(XDate) & _
         " 12:00AM' AND [ReceivedTime] < '" & _
          CStr(XDate + 1) & " 12:00AM'"

你也遇到过Item.Move的问题。您应该在那里指定Outlook.Folder类型的对象

整个子变成了

Option Explicit

Sub Move_Yesterdays_Emails()


'***Creates a new folder named yesterdays date under the inbox***

 Dim myNameSpace As Outlook.NameSpace
 Dim myFolder As Outlook.Folder
 Dim myNewFolder As Outlook.Folder
 Dim xDay As String
 Dim XDate As Date

    If Weekday(Now()) = vbMonday Then
        XDate = Date - 3
    Else
        XDate = Date - 1
    End If

 Set myNameSpace = Application.GetNamespace("MAPI")
 Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
 Set myNewFolder = myFolder.Folders.Add(XDate)

'***Finds all emails in the inbox from yesterday and moves them to the created folder***

    'Dim myNameSpace As Outlook.NameSpace ---> DUPLICATE DECLARATION
    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(XDate) & _
             " 12:00AM' AND [ReceivedTime] < '" & _
              CStr(XDate + 1) & " 12:00AM'"

        Debug.Print Filter

    Set myNameSpace = Application.GetNamespace("MAPI")
    Set Inbox = myNameSpace.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)
            Set Item = Items(i)
            Item.Move myNewFolder
        End If
    Next
End Sub

以上是关于从上一个工作日移动电子邮件什么都不做的主要内容,如果未能解决你的问题,请参考以下文章

Process.Start() 啥都不做

如果变量=数字,做X,否则啥都不做

从 Java 调用在 cmd 中执行 .bat 啥都不做

“git diff”啥都不做

覆盖 css hover 让它什​​么都不做

将 UIView.transform 设置为任意翻译 CGAffineTransform 啥都不做