如何标记和移动超过三天的未读消息？

Question

我想用标志标记所有超过三天的未答复电子邮件，并将它们移动到名为“mini”的文件夹中。来源是“Posteingang”（收件箱的德语）。

Sub Mails_verschieben()
  
    Set myaccount = Application.GetNamespace("MAPI").DefaultStore
    Set mynamespace = Application.GetNamespace("MAPI")
  
    Dim ursprung As MAPIFolder
    Dim ziel As MAPIFolder
  
    Set ursprung = Session.Folders(myaccount.DisplayName).Folders("Posteingang")
    Set ziel = Session.Folders(myaccount.DisplayName).Folders("mini")
  
    For i = ursprung.Items.Count To 1 Step -1 'alle emails im Postfach durchgehen
        With ursprung.Items(i)
            If .ReceivedTime < Date - 3 And ursprung.Items(i) = .LastModificationTime Then
                .FlagIcon = 5
                .FlagStatus = olFlagMarked
                .Save
                ursprung.Items(i).Move ziel 'in Ordner verschieben
            End If
        End With
    Next i   

End Sub

我明白了

对象不支持此属性或方法

在

If .ReceivedTime < Date - 3 And ursprung.Items(i) = .LastModificationTime Then

我也想自动运行这个脚本，但什么也没找到。

我修改了我的代码：

Sub Mails_verschieben()

    Set myaccount = Application.GetNamespace("MAPI").DefaultStore
    Set mynamespace = Application.GetNamespace("MAPI")
  
    Dim ursprung As MAPIFolder
    Dim ziel As MAPIFolder
    Dim MailX As MailItem
  
    Set ursprung = mynamespace.GetDefaultFolder(olFolderInbox)
    Set ziel = Session.Folders(myaccount.DisplayName).Folders("mini")
    
    For i = ursprung.Items.Count To 1 Step -1 'alle emails im Postfach durchgehen
        For Each MailX In ursprung.Items(i)
            If MailX.ReceivedTime < Date - 3 And ursprung.Items(i) = MailX.LastModificationTime Then
                MailX.FlagIcon = 5
                MailX.FlagStatus = olFlagMarked
                MailX.Save
                ursprung.Items(i).Move ziel 'in Ordner verschieben
            End If
        Next
    Next i
End Sub

同样出现错误。

Answer 1

首先，请记住 Outlook 文件夹可能包含不同的项目类型 - 邮件、约会、文档等。在运行时检查项目类型以确保在访问其属性之前处理邮件项目。例如：

For x = 1 To Items.Count  
 If Items.Item(x).Class = OlObjectClass.olMail Then  
 ' For mail item, use the SenderName property. 
 End If
Next

其次，要获取标准/默认收件箱文件夹，您不需要使用以下代码：

Set ursprung = Session.Folders(myaccount.DisplayName).Folders("Posteingang")

改为使用NameSpace.GetDefaultFolder 方法，该方法返回一个Folder 对象，该对象代表当前配置文件所请求类型的默认文件夹。

Set ursprung = mynamespace.GetDefaultFolder(olFolderInbox) 

第三，而不是遍历文件夹中的所有项目：

For i = ursprung.Items.Count To 1 Step -1 'alle emails im Postfach durchgehen
    With ursprung.Items(i)

您需要使用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

Answer 2

似乎有一个不需要的条件

If MailX.ReceivedTime < Date - 3 And ursprung.Items(i) = MailX.LastModificationTime Then

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Sub Mails_verschieben2()
    
    Dim ursprung As Folder
    Dim ziel As Folder
    
    Dim ursprungItems As Items
    Dim i As Long
    
' Not usual
    Dim myDefaultStore As Store
    Set myDefaultStore = Session.defaultStore
    
    Set ursprung = Session.Folders(myDefaultStore.DisplayName).Folders("Posteingang")
    'Set ursprung = Session.Folders(myDefaultStore.DisplayName).Folders("Inbox")
    Debug.Print ursprung.name
    
' Standard
    Set ursprung = Session.GetDefaultFolder(olFolderInbox)
    Debug.Print ursprung.name
    
    'Folder at same level as Inbox
    Set ziel = ursprung.Parent.Folders("mini")
    Debug.Print ziel.name
    
    Set ursprungItems = ursprung.Items
    ursprungItems.Sort "[ReceivedTime]", True ' newest first
    
    ' You could use .Restrict but in normal sized inboxes
    '  the time saved may not be noticeable.
    For i = ursprungItems.count To 1 Step -1 'alle emails im Postfach durchgehen
        
        ' Verify that the item is a mailitem
        '  before attempting to return mailitem properties
        If TypeOf ursprungItems(i) Is mailItem Then
                            
            With ursprungItems(i)
            
                If .ReceivedTime < Date - 3 Then
                    '.FlagIcon = 5
                    '.FlagStatus = olFlagMarked
                    '.Save
                    '.Move ziel 'in Ordner verschieben
                    
                    Debug.Print "Older mail."
                    Debug.Print " Subject: " & .Subject
                    Debug.Print "  ReceivedTime: " & .ReceivedTime
                    
                Else
                    Debug.Print "Newer mail."
                    Debug.Print " Subject: " & .Subject
                    Debug.Print "  ReceivedTime: " & .ReceivedTime
                    
                    Exit For    ' Stop when newer mail encountered.
                    
                End If
                
            End With
            
        Else
        
            Debug.Print "Non-mailitem ignored."
            
        End If
        
    Next i
    
    Debug.Print "Done."
    
End Sub