5
Outlook-Makro doppelte Mail-Adressen entfernen
Hallo ihr Lieben,
ich schlage mich seit einer kleinen Weile mit einem Problem rum. Ich erstelle automatisiert Mails, die mit Inhalt und BCC-Adressen gefüllt sind. Ich möchte nun, dass mein Makro den Ordner, wo alle Entwürfe liegen, durchsucht. Sobald eine Mailadresse im BCC-Feld aller Mails mehr als einmal vorkommt, soll diese aus der entsprechenden Mail gelöscht werden. Es soll also jede Adresse nur einmal unter allen Mails vorkommen.
im folgenden Code läuft alles durch aber doppelte Adressen werden nicht gelöscht und ich verstehe nicht warum - kann mir jemand helfen?:
ich schlage mich seit einer kleinen Weile mit einem Problem rum. Ich erstelle automatisiert Mails, die mit Inhalt und BCC-Adressen gefüllt sind. Ich möchte nun, dass mein Makro den Ordner, wo alle Entwürfe liegen, durchsucht. Sobald eine Mailadresse im BCC-Feld aller Mails mehr als einmal vorkommt, soll diese aus der entsprechenden Mail gelöscht werden. Es soll also jede Adresse nur einmal unter allen Mails vorkommen.
im folgenden Code läuft alles durch aber doppelte Adressen werden nicht gelöscht und ich verstehe nicht warum - kann mir jemand helfen?:
Sub RemoveDuplicateBCCAddresses()
Dim olNamespace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olMail As Outlook.MailItem
Dim dictAddresses As Object
Dim i As Integer
' Outlook-Anwendung und Namespace abrufen
Set olNamespace = Application.GetNamespace("MAPI")
' Ordnerauswahl anzeigen
Set olFolder = olNamespace.PickFolder
If olFolder Is Nothing Then
MsgBox "Kein Ordner ausgewählt. Das Makro wird abgebrochen.", vbExclamation
Exit Sub
End If
Set dictAddresses = CreateObject("Scripting.Dictionary")
For Each olMail In olFolder.Items
If olMail.Class = olMail And olMail.Sent = False Then ' Nur Entwürfe bearbeiten
If olMail.BCC <> "" Then
Dim arrAddresses() As String
arrAddresses = Split(olMail.BCC, ";")
Dim updatedBCC As String
updatedBCC = ""
For i = LBound(arrAddresses) To UBound(arrAddresses)
If Not dictAddresses.Exists(arrAddresses(i)) Then
dictAddresses(arrAddresses(i)) = 1
updatedBCC = updatedBCC & arrAddresses(i) & ";"
End If
Next i
olMail.BCC = updatedBCC
olMail.Save
End If
End If
Next olMail
Set olMail = Nothing
Set olFolder = Nothing
Set olNamespace = Nothing
Set dictAddresses = Nothing
MsgBox "Doppelte BCC-Adressen wurden entfernt.", vbInformation
End Sub
Share on Facebook
Share on Twitter
Share on Reddit
Share on LinkedinPlease also mark the comments that contributed to the solution of the article
Content-Key: 7458456289
Url: https://administrator.de/contentid/7458456289
Printed on: May 5, 2024 at 17:05 o'clock
5 Comments
Latest comment
Moin.
die BCC Property enthält ja nur die Namen (Namen sind Schall und Rauch, die E-Mail Adressen zählen!) benutze stattdessen die Recipient Collection die hat gleich auch eine Delete Methode um die Adressen zu entfernen und eine Type Property die bei BCC Recipients auf olBCC gesetzt ist.
https://learn.microsoft.com/de-de/office/vba/api/outlook.recipient#prope ...
Ungetestet (gerade am Smartphone) etwa so
Aber wozu der ganze Aufwand? Doppelte Adressen werden doch schon automatisch beim Senden durch Outlook entfernt?! Spätestens der Mailserver erkennt das und schickt die Nachricht auch nur einmal an den Empfänger.
Zeppel
die BCC Property enthält ja nur die Namen (Namen sind Schall und Rauch, die E-Mail Adressen zählen!) benutze stattdessen die Recipient Collection die hat gleich auch eine Delete Methode um die Adressen zu entfernen und eine Type Property die bei BCC Recipients auf olBCC gesetzt ist.
https://learn.microsoft.com/de-de/office/vba/api/outlook.recipient#prope ...
BCC Diese Eigenschaft enthält nur die Anzeigenamen. Die Recipients -Auflistung sollte verwendet werden, um die BCC-Empfänger zu ändern.
Ungetestet (gerade am Smartphone) etwa so
Sub RemoveDuplicateBCCAddresses()
Dim olNamespace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olMail As Outlook.MailItem
dim recipient as Recipient
' Outlook-Anwendung und Namespace abrufen
Set olNamespace = Application.GetNamespace("MAPI")
' Ordnerauswahl anzeigen
Set olFolder = olNamespace.PickFolder
If olFolder Is Nothing Then
MsgBox "Kein Ordner ausgewählt. Das Makro wird abgebrochen.", vbExclamation
Exit Sub
End If
Set dictAddresses = CreateObject("Scripting.Dictionary")
For Each olMail In olFolder.Items
If olMail.Class = olMail And olMail.Sent = False Then ' Nur Entwürfe bearbeiten
If olMail.BCC <> "" Then
dim recCollection as New Collection
foreach recipient in olMail.Recipients
if recipient.type = olBCC then
if dictAddresses.Exists(recipient.Address) then
recCollection.Add recipient
else
dictAddresses.Add recipient.Address,""
end if
End if
Next
if recCollection.Count > 0 then
foreach recipient in recCollection
recipient.delete
Next
olMail.Save
end if
End If
End If
Next
Set olMail = Nothing
Set olFolder = Nothing
Set olNamespace = Nothing
Set dictAddresses = Nothing
MsgBox "Doppelte BCC-Adressen wurden entfernt.", vbInformation
End SubZeppel
Hallo Zeppel,
vielen Dank für die schnelle Antwort. Ich hab mich leider nicht gut ausgerückt. Es geht nicht darum nur von einer Mail die BCC-Adressen zu kontrollieren. Es werden ca. 100 Entwürfe in einem Ordner liegen und in allen Entwürfen sind unterschiedliche Adressen im Bcc-Feld. Es kann aber sein, dass beispielswiese in Mail 1 eine Adresse ist, die auch in Mail 51 vorkommt. Und das Programm soll alles Mailübergreifend kontrollieren und entsprechend löschen.
vielen Dank für die schnelle Antwort. Ich hab mich leider nicht gut ausgerückt. Es geht nicht darum nur von einer Mail die BCC-Adressen zu kontrollieren. Es werden ca. 100 Entwürfe in einem Ordner liegen und in allen Entwürfen sind unterschiedliche Adressen im Bcc-Feld. Es kann aber sein, dass beispielswiese in Mail 1 eine Adresse ist, die auch in Mail 51 vorkommt. Und das Programm soll alles Mailübergreifend kontrollieren und entsprechend löschen.
Ah OK, macht das obige auch.
Moin Zeppel 
ich habe den Code ausprobiert und er läuft auch durch bzw. sagt final, dass doppelte Adressen entfernt wurden, aber sie befinden sich noch immer im Bcc-Feld.
ich habe den Code ausprobiert und er läuft auch durch bzw. sagt final, dass doppelte Adressen entfernt wurden, aber sie befinden sich noch immer im Bcc-Feld.
Kleiner Tippfehler wurde behoben. Klappt hier im Test dann einwandfrei.
