Hallo Liebe Community,

Ich habe folgenden Code:

Sub Reader()

    Dim MobjOL As Outlook.Application
    Dim MobjNS As NameSpace
    Dim MobjMF As MAPIFolder
    Dim MobjGF As Folder
    Dim MobjSF As Folder
    Dim Sender As String
    Dim Comp As String
    
    Set MobjOL = CreateObject("Outlook.Application")
    Set MobjNS = MobjOL.GetNamespace("MAPI")
    Set MobjMF = MobjNS.GetDefaultFolder(olFolderInbox)
    
    Sender = GetSender()
    Comp = GetComp(Sender)
    
    If MobjMF.Folders(Comp) Is Nothing Then
        Set MobjGF = MobjMF.Folders.Add(Comp)
    Else
        Set MobjGF = MobjMF.Folders(Comp)
    End If
    
    If MobjGF.Folders(Sender) Is Nothing Then
        Set MobjSF = MobjGF.Folders.Add(Comp)
    Else
        Set MobjSF = MobjGF.Folders(Comp)
    End If
      

    MoveMail Sender, Comp


End Sub

der bewirken soll das bei einer eingehnden Email die Mail automatisch einsortiert wird und das nach 2 Gesichtspunkten.

1. Der Firma

2. Des Namens des Absenders

Die Funktionen GetComp und GetSender ermitteln mir diese Informationen. Daraus möchte ich dann anschließend eine Ordner Struktur erstellen.

-Firma

   -Name

        -Mail

        -Mail

    -Name

-Firma

....

Das ganze funktioniert auch soweit sehr gut. Bis auf die Tatsache das wenn einer der Ordner schon existiert (Firma oder Name) er mir einen Fehlercode ausspuckt.

Wenn ich denn Error Code per On error Resume Next einfach ignoriere erstellt er aber möglicherweise den Unterordner nicht mehr...

Ich hoffe ihr könnt mir Behilflich sein !

Vielen dank vorab !