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
|