How to mark and move unread messages older than three days? - vba

Question

I want to mark all unanswered emails, older than three days, with a flag and move them into a folder named "mini". The source is "Posteingang" (German for inbox).
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
I get
Object Doesn't Support this Property or Method
at
If .ReceivedTime < Date - 3 And ursprung.Items(i) = .LastModificationTime Then
I want also to run this script automatically but found nothing.
I modified my code:
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
Also getting error.

Answer 1

First, please remember that an Outlook folder may contain different item types - mails, appointments, documents and etc. Check the item type at runtime to make sure you deal with mail item before accessing their properties. For example:
For x = 1 To Items.Count
If Items.Item(x).Class = OlObjectClass.olMail Then
' For mail item, use the SenderName property.
End If
Next
Second, to get the standard/default Inbox folder you don't need to use the following code:
Set ursprung = Session.Folders(myaccount.DisplayName).Folders("Posteingang")
Instead, use the NameSpace.GetDefaultFolder method which returns a Folder object that represents the default folder of the requested type for the current profile.
Set ursprung = mynamespace.GetDefaultFolder(olFolderInbox)
Third, instead of iterating over all items in a folder:
For i = ursprung.Items.Count To 1 Step -1 'alle emails im Postfach durchgehen
With ursprung.Items(i)
You need to use the Find/FindNext or Restrict methods of the Items class. Read more about these methods in the following articles:
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

There appears to be an unneeded condition in
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