email Adressen in Excel Spalte zusammenführen und eMail versenden

[Daniel Albert]

Guten Morgen,

ich habe mal wieder eine Herausforderung die ich allein nicht bewältigen kann.

Ich habe eine Excel Tabelle für unsere Mittagsbetreuung wo alle relevanten Kundendaten der Mitglieder erfasst sind. In einer Spalte ist auch die jeweilige eMail hinterlegt.

Nun ist mein Ziel über ein Makro folgendes zu erreichen.

1. Es sollen alle emails auf dubletten geprüft werden, da manchen Eltern auch 2 Kindern in der Betreuung haben
2. Die email Adressen sollen dann in die BCC Adressliste des emailprogramms hier Outlook eingefügt werden, sprich Outlook macht über das Makro ne neue eMail auf und fügt die eMail Adressen in BCC ein.

Ist das möglich ?

[Storax]

Ja, hier die Links mit den Infos, die Du i.w. benötigst
http://www.rondebruin.nl/win/s1/outlook/mail.htm
https://support.office.com/de-de/article...a552dc138d

[Daniel Albert]

Ok den ersten Link schaue ich mir mal an. Der 2te ist ja ein händischer Ablauf und es werden ja in den Zellen die eMails entfernt welche doppelt vorhanden sind. Dieser Schritt soll ja vollautamtisch funktionieren.

Idee wäre eine 2te Tabelle als Zwischenschritt einbauen.

[Storax]

Die notwendigen Infos liefert der zweite Link auch, denn Du kannst die Schritte mit dem Makrorekorder aufzeichnen. Dann sieht Du, dass die Methode RemoveDuplicates verwendet wird.
Dazu könntest die Doku suchen und schon bist Du wieder einen Schritt weiter. Aber ich befürchte, Du machst den zweiten Schritt vor dem ersten. Im Grunde benötigst Du das
PS Eine andere Möglichkeit wäre es, die E-Mail Adressen in ein Dictionary zu packen

PS Hier die Möglichkeit die E-Mail Adressen mit Hilfe des Dictionaries ohne Dubletten aufzulisten

Code:

Option Explicit

Function EmailList(rg As Range) As Dictionary
' Creates unique list of values from rg

Dim eMail As Object
Dim vMail() As Variant
Dim i As Long

   ' Only one column allowed
   If rg.Columns.Count > 1 Then
       Set EmailList = Nothing
       Exit Function
   End If

   'Set eMail = New Scripting.Dictionary
   Set eMail = CreateObject("Scripting.Dictionary")

   vMail = rg

   For i = LBound(vMail, 1) To UBound(vMail, 1)
       If eMail.Exists(vMail(i, 1)) Then
           ' key (email) exist, do not add
       Else
           eMail.Add vMail(i, 1), vMail(i, 1)
       End If
   Next i

   Set EmailList = eMail

End Function

Sub TestIt()
Dim i As Long
Dim rg As Range
Dim eMail As Object
Dim aMail As Variant
   'Dim eMail As Scripting.Dictionary

   ' Example - data located in activesheet
   Set rg = Range("A1:A6")
   Set eMail = EmailList(rg)
   
   If eMail Is Nothing Then
       ' Hint that list is empty
       MsgBox "Nothing was retrieved", vbOKOnly + vbInformation, "Empty list"
   Else
       ' one method to access the dictionary
       For i = 0 To eMail.Count - 1
           Debug.Print eMail.Keys()(i)
       Next i

       ' another method to acceess the dictionary
       Dim mStr As String
       aMail = eMail.Keys
       For i = LBound(aMail) To UBound(aMail)
           Debug.Print aMail(i)
           mStr = mStr & aMail(i) & vbCrLf
       Next i
       
       ' Display in MsgBox
       MsgBox mStr, vbOKOnly + vbInformation, "List"
   End If

End Sub

[Daniel Albert]

OK, also brauche ich dann emails nicht noch einmal separat in eine extra Tabelle zu übertragen ohne Dubletten?

[Storax]

Genau, die E-Mails ohne Dubletten sind in dem Dictionary enthalten.