ich habe in der Vergangenheit versucht auf diesem Wege eine Möglichkeit zu finden, eine Verteilerliste dynamisch in einem Tabellenblatt zu gestalten. Ich habe aus diesem Forum heraus einen sehr guten Code erhalten. Dieser Code erlaubt es allerdings nur "hart" in VBA programmierte Personen anzuschreiben. Ich möchte nun dem Bediener ermöglichen in einer Tabelle die Empfänger (!!! Wichtig!!!: die Empfänger, nicht nur einer) selbst zu pflegen, damit ich nicht immer das VBA "anpassen" muss. Ich habe unten noch einmal den Code eingestellt.
Sub mailversand()
Dim Betreff As String
Dim Empfaenger As String
Dim Text1 As String
Dim Text2 As String
Dim Text3 As String
Dim ABSENDER As String
Dim DATEIANHANG As String
Dim rtitem As Object
Dim EmbeddedObject As Object
Empfaenger = MailTo
Betreff = "Daily Report " & Date & " " & Time
Text1 = MailText
DATEIANHANG = "G:\Pfad\Tagesbericht.xls"
ABSENDER = ""
On Error GoTo Err_Mail_Click
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 melden Sie sich zunächst vollständig in Notes an!", vbInformation + vbOKOnly
Exit Sub
End If
'Verteiler für den Mailversand
Dim recip(35) As Variant
recip(0) = "Empfänger 1"
recip(1) = "Empfänger 2"
recip(2) = "Empfänger 3"
recip(3) = "Empfänger 4"
Set NotesDoc = NotesDB.CreateDocument
With NotesDoc
.Form = "Memo"
.Subject = "Daily Report " & Date
.sendto = recip
'.sendto = "" ' Adresse für Empfänger
'.copyto = "" ' Adresse für Kopie an
'.blindcopyto = "" 'Adresse für Blindkopie
.body = "Anbei erhalten Sie die aktuellen Tagesdaten. " & Chr$(13) _
& " " & Chr$(13) _
& "Mit freundlichen Grüßen" & Chr$(13) _
& "Abt." 'Text
'.body = Text1 & vbCrLf & ABSENDER
'.DefaultMailSaveOption = 0
'.MailSaveOption = 0
.DeliveryReport = "B"
.Importance = "2"
'.logo = "LOGO"
.SAVEMESSAGEONSEND = False ' bei True wird ein Exemplar in Notes in Gesendet gestellt
'.ReturnReceipt = "1"
.Sign = "1"
'.encrypt ="0"
'.Principal = session.UserName
'.viewicon ="74"
'.from = session.UserName
'.SaveOptions = 0
'.SecureMail = ""
'.SenderTag = "F"
''''''''''''''''''''''''''''' Dateianhang''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
Exit_Mail_Click:
Exit Sub
Err_Mail_Click:
MsgBox Err.Description
Resume Exit_Mail_Click
End Sub