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?:

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

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 7458456289

Url: https://administrator.de/contentid/7458456289

Ausgedruckt am: 24.11.2024 um 02:11 Uhr

5 Kommentare

Neuester Kommentar

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

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 Sub

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

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.

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.