Emails mit selbem Betreff filtern im Posteingang,aktuellstes behalten, altes verschieben

	'Deklaration  
    Dim FolderInbox As MAPIFolder
    Dim FolderDest As MAPIFolder
    
    Dim Mails As Outlook.Items
    Dim Mail As Object
	Dim Jump as String
    
	
    'Outlook als Object erstellen  
    Set MyOLApp = CreateObject("Outlook.Application")  
    Set myNameSpace = MyOLApp.GetNamespace("MAPI")  
    
    'Default-Mailbox nehmen.. manche haben nur eine, andere ein Dutzend  
    ' die aktive Mailbox laut Profil ist logischerweise der Parent (neudeutsch für "Vadder" vom "Posteingang"  
    Set FolderInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
    Set FolderDest = FolderInbox.Parent.Folders("Gelöschte Objekte")  
    
    
	jump="0"  
    Set Mails = FolderInbox.Items
    Set Mail = Mails.Find("[Subject]  <> '\-\-\-\-\-\-\-\-\-\-\-\-/-/-/-/-/-/-/-/-/-/-/' ")  
    Do While TypeName(Mail) <> "Nothing"  
	
		If (1, jump, "0", vbTextCompare) <> 0 Then   
			jump=1
			
		ElseIf (InStr(1, Mail.Subject, "Dein BETREFF", vbTextCompare)) <> 0 Then  
            Mail.UnRead = False
            Mail.Move FolderDest
			
        End If
		
		'Makiert die nächste Mail  
        Set Mail = Mails.FindNext
    Loop

	
    'Variablen löschen  
    Set myNameSpace = Nothing
    Set FolderDest = Nothing
    
    Set Mails = Nothing
    Set Mail = Nothing