Hallo Alex,

hab mal ein bischen zusammengebastelt, weiss auch nicht mehr wo ich das her habe, einfach in Outlook in ein Modul reinpacken

Option Explicit

Sub neue_mail(sID As String)

   On Error Resume Next
   'MsgBox "! " & sID
   Dim mIt As Outlook.MailItem
   Dim sIt As String
   Dim sPos As String
   
   Dim i As Long
   Dim a As Long
   Dim n As Long
   
   Dim sAnr As String
   Dim sPfad As String
   Dim sOrdner As String
   Dim Gültig As Boolean

   If NS Is Nothing Then
      Set NS = Outlook.GetNamespace("MAPI")
   End If

   Stmp = TypeName(NS.GetItemFromID(sID))

   If Stmp = "MailItem" Then
      Set mIt = NS.GetItemFromID(sID)
   Else
      MsgBox "Die neue Mail ist vom unerwarteten Typ " & vbLf & Stmp & vbLf & " und kann mit dem existierenden Makro nicht verarbeitet werden.", vbCritical, "Abbruch"
      Exit Sub
   End If

   Gültig = False
   
   sIt = Mid(mIt.SenderEmailAddress, InStr(mIt.SenderEmailAddress, "@"))
   sIt = LCase(sIt)
   'MsgBox "E-Mail von: " & Mid(sIt, 2)
   Select Case sIt
      Case "@aaa.de"
         If mIt.Attachments.Count > 0 Then
            For i = 1 To mIt.Attachments.Count
               Datei = mIt.Attachments.Item(i).FileName
               msgbox Datei
            Next
         End If
   
      Case "@bbb.de"
         Gültig = True
         sOrdner = "aaa"
      Case "@ccc.de"
         Gültig = True
         sOrdner = "bbb"
      Case "@ddd.com"
         Gültig = True
         sOrdner = "ccc"
      Case "@eee.de"
         Gültig = True
         sOrdner = "ccc"
   End Select
   
   Select Case sordner
     Case "aaa"
        Set oFldr = Ns.GetDefaultFolder(olFolderInbox)
     Case "bbb"
        Set oFldr = NS.Folders("aaa").Folders("abc")
     Case "ccc"
        Set oFldr = NS.Folders("aaa").Folders("bcd")
     Case "ddd"
        Set oFldr = NS.Folders("ddd").Folders("abc")
     Case "eee"
        Set oFldr = NS.Folders("eee").Folders("Posteingang")
     Case Else
        Set oFldr = Ns.GetDefaultFolder(olFolderInbox)
   End Select
  
   Set mIt = Nothing


         For Each oMessage In oFldr.Items
            With oMessage
               'If .UnRead Then
                  .move oFdldr
               'End If
            End With
         Next
End Sub

nicht getestet

Gruß Detlev