Hallo Excel-Experten,

ich habe ein Problem beim addieren von Emailempfängern, gesendet über Lotus Notes.
Was geschieht?

1. Der User wählt in einer Combobox einen Schweregrad aus  (von 1 bis 3)

2. Der User wählt Emailempfänger per Checkbox. Hinter jeder Checkbox stehen 2 bis 15 Emailadressen. (Im Beispiel sind 2 Checkboxen mit Zelle A2 und A5 verbunden)

3. Der User klickt einen CommandButton, sodass das Workbook per Email an den Verteiler gesendet wird, eben abhängig vom gewählten Schweregrad und der Checkboxwahl. Es ist alos über die Checkboxwahl sehr variabel, wer die Email bekommt.

Mein Problem ist aber, dass ich zurzeit nur einen Empfänger anwählen kann, d.h. das Makro addiert nicht die per Checkbox gewählten Empfänger, sondern überschreibt sie einfach.
(Testweise zeigt der nachstehende Code nur die Empfänger in den Zellen A2 und A5, nicht den ganzen Verteiler)

Wie kann man das so programmieren, dass alle angewählten Emailadressen in der To-Zeile der Email addiert werden? Hat das etwas mit preserve zu tun? Ich kenne mich da leider nicht mit aus.

Übrigens: die Checkboxen liegen, wie der VBA-Code, im Blatt "Eingabe Alert", die Emailadressen stehem im Blatt "Emailverteiler".

Hier einmal mein erster Versuch mit If:

'Makro 7: E-Mail versenden mit Anhang der im Makro 6 erstellten Blindkopie. Der Emailverteiler ist abhängig vom gewählten 
'Schweregrad und der Checkbox-Auswahl. 
Dim Empfaenger As Variant 
Dim rtitem As Object 
Dim EmbeddedObject As Object 
Dim Tosenden 
Dim CCsenden 
Dim BCCsenden 
Dim Betreff As String 
Dim Text As String 
Dim Cells As Range 
Dim Linkanhang As String 

'Schweregrad 1 ist selektiert: 
Select Case Schweregrad.Value 
Case "1" 
With Worksheets("Emailverteiler") 
Linkanhang = .Range("A1") 'anpassen 
Dateianhang = Linkanhang 

'ab hier beginnt mein Problem 
If ActiveWorkbook.Worksheets("Eingabe Alert").SDE.Value = True Then 
Tosenden = .Range("A2") '.Resize(.Cells(100, 1).End(xlUp).Row) 
If ActiveWorkbook.Worksheets("Eingabe Alert").SQE.Select Then 
Tosenden = .Range("A5") '.Resize(.Cells(100, 1).End(xlUp).Row) 
'If ActiveWorkbook.Worksheets("Eingabe Alert").FB.Select Then 
' Tosenden = .Range("A2") '.Resize(.Cells(100, 1).End(xlUp).Row) 
'If ActiveWorkbook.Worksheets("Eingabe Alert").FKZyl.Select Then 
' Tosenden = .Range("A2") '.Resize(.Cells(100, 1).End(xlUp).Row) 
'If ActiveWorkbook.Worksheets("Eingabe Alert").FKPleul.Select Then 
' Tosenden = .Range("A2") '.Resize(.Cells(100, 1).End(xlUp).Row) 
etc. 
End If 

Betreff = .Range("A3") & (" Schweregrad: 1") 
Text = .Range("A4") 
End With 

Dim SessionNotes As Object, NotesDB As Object, NotesDoc As Object 
Set SessionNotes = CreateObject("Notes.NOTESSESSION") 
Set NotesDB = SessionNotes.GetDatabase("", "") 
NotesDB.OPENMAIL 
If NotesDB.IsOpen = False Then 
MsgBox "Bitte in Lotus Notes anmelden!", vbInformation + _ 
vbOKOnly 
Exit Sub 
End If 
Set NotesDoc = NotesDB.CreateDocument 
With NotesDoc 
.Form = "Memo" 
.Subject = Betreff 
.sendto = Tosenden 
.copyto = CCsenden 
.blindcopyto = BCCsenden 
.body = Text 
.DeliveryReport = "B" 
.Importance = "1" 
.SAVEMESSAGEONSEND = True 
.ReturnReceipt = "1" 
.Sign = "1" 

If Trim$(Dateianhang) <> "" Then 
Const embed_ATT = 1454 
Set rtitem = .CREATERICHTEXTITEM("DATEIANHANG") 
Set EmbeddedObject = rtitem.EMBEDOBJECT(embed_ATT, "", Dateianhang, "DATEIANHANG") 
End If 

.SEND False 
End With 
Set SessionNotes = Nothing 
Set NotesDB = Nothing 
Set NotesDoc = Nothing 
Set rtitem = Nothing 
Set EmbeddedObject = Nothing 
End Select

Ich hoffe ich konnte mich verständlich machen.

Vielen Dank im Voraus für die Hilfe und einen schönen Tag wünscht

Holger