Using VBA for Outlook to mark unread messages-CodePudding

I have a huge problem. I want to mark all unanswered emails (older than 3 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

So basically when I run it, I get

Object Doesn't Support this Property or Method

at line

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

So I want also to run this script automatically but found nothing.

UPDATE:

So I have modified my code and my result is now this one:

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. What is now the Issue?

CodePudding user response：

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:

CodePudding user response：

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