hallo zusammen,
da ich von den Möglichkeiten der Regeln in OL nicht ganz begeistert bin habe ich ein Makro (Code siehe gaaaanz unten) geschrieben, das mir e-Mails verschiebt, sofern der Empfänger oder Sender in einem betsimmten Adressbuch steht. Ich erkenne diese auch zuverlässig, aber dann kommt das verschieben…
Verwende ich das Ereignis ItemSend, ist das Ding noch nicht verschickt, also kann ich es nicht verschieben.
Verwende ich newMail passiert erstmal nichts, da ja beim Senden keine neue e-Mail gekommen ist. Kommt dann eine werden alle „privaten“ auch brav aufgeräumt, aber halt „zu spät“.
Zur Lösung suche ich entweder:
Gibt es ein Ereigniss, das man abfangen kann wenn z.B. ein Objekt verschoben wird oder ein neues in einen „beliebigen“ Ordner kommt?
Oder:
Wie kann ich im ItenSend Ereignis dafür sorgen, dass erstmal gesendet wird, bevor ich verschiebe.
Ach ja: OL 2002 SP3
Freue mich auf alle Antworten und vielen Dank schonmal!
biba
Dirk.Pegasus
Private Sub Application\_NewMail()
Dim preItem As Variant
Dim message As MailItem
Dim myRecipient As Recipient
Dim addrItem As ContactItem
Set adressFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
On Error Resume Next
For Each preItem In Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
If TypeName(preItem) = "MailItem" Then
Set message = preItem
If message.UnRead Then
Set addrItem = adressFolder.Items.Find("[Email1Address] = """ & GetExchangeSenderAddress(message) & """")
If Not TypeName(addrItem) = "Nothing" Then
If (addrItem.Sensitivity olNormal) Then
message.ReadReceiptRequested = False
message.UnRead = False
message.Move (Application.GetNamespace("MAPI").Folders("Privat").Folders("Privater Eingang"))
End If
End If
End If
End If
Next
For Each preItem In Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).Items
If TypeName(preItem) = "MailItem" Then
If preItem.Sent Then
For Each myRecipient In preItem.Recipients
Set addrItem = adressFolder.Items.Find("[Email1Address] = """ & myRecipient.Address & """")
If TypeName(addrItem) = "Nothing" Then
Set addrItem = adressFolder.Items.Find("[Email2Address] = """ & myRecipient.Address & """")
End If
If TypeName(addrItem) = "Nothing" Then
Set addrItem = adressFolder.Items.Find("[Email3Address] = """ & myRecipient.Address & """")
End If
If Not TypeName(addrItem) = "Nothing" Then
If (addrItem.Sensitivity olNormal) Then
preItem.Move (Application.GetNamespace("MAPI").Folders("Privat").Folders("Privater Ausgang"))
End If
End If
Next
End If
End If
Next
End Sub
