Outlook – Mit VBA Macro Emails älter als 1 Tag verschieben

Sub ExtraFilter()

    ' Get the MAPI Outlook NameSpace
    Dim objNS As Outlook.NameSpace: Set objNS = GetNamespace("MAPI")
    
    ' Get the Inbox Folder
    Dim olFolder As Outlook.MAPIFolder
    Set olFolder = objNS.GetDefaultFolder(olFolderInbox)

    ' Get the Target Folder
    Dim BUILD_INFOs As Outlook.MAPIFolder
    Set BUILD_INFOs = objNS.Folders("meine@emailaddresse.org").Folders("BUILD_INFOs")
    
    ' Test if the Target Folder exist
    Debug.Print BUILD_INFOs.Items.Count
    
    Dim Item As Object
    
    ' Loop through each item
    For Each Item In olFolder.Items
        If TypeOf Item Is Outlook.MailItem Then
            Dim oMail As Outlook.MailItem: Set oMail = Item
            
            ' Check email address of the sender
            If oMail.SenderEmailAddress = "noreply@jenkinsbuild.com" Then
                Debug.Print oMail.SenderEmailAddress
                
                ' The Big Difference: date older than days "d"
                If DateDiff("d", oMail.CreationTime, Now) > 1 Then
                    Debug.Print oMail.CreationTime
                    ' Move it to target folder
                    oMail.Move BUILD_INFOs
                End If
            End If
            
        End If
    Next

End Sub
Tags: