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 !
|