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 ?
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.
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
OK, also brauche ich dann emails nicht noch einmal separat in eine extra Tabelle zu übertragen ohne Dubletten?
Genau, die E-Mails ohne Dubletten sind in dem Dictionary enthalten.