VBA: Verschieden viele Einträge in Array
15.09.2017 16:31:28
Henner
Mit dem untenstehenden Code versende ich E-Mails via Lotus Notes an mehrere Empfänger. Damit ich an mehrere Empfänger senden kann, müssen die Empfänger in einem Array festgelegt werden.
Nun möchte ich die einzelnen Empfänger aber aus einer Spalte (A) einlesen, in der die Empfänger untereinander aufgelistet sind (1 Empfänger pro Zelle). Die Anzahl der Empfänger variiert zwischen 1 und 40.
Genial wäre es, wenn zwischen den einzelnen Empfängern auch leere Zellen sein dürfen. Muss aber nicht unbedingt.
Wer kann mir sagen wie ich es realisieren kann, damit die Empfänger aus den Zellen eingelesen werden und die Anzahl dabei flexibel ist?
Sub SendMail()
Dim Betreff$, Anhang As Variant, empfänger As Variant, cc$, bcc$, Mailtext$
Betreff = "Dies ist eine Nachricht"
empfänger = Array("user1@test.de", "user2@test.de", "user3@test.de")
cc = ""
bcc = ""
Mailtext = "Test Test Test"
SendNotesMail Betreff, Anhang, empfänger, cc, bcc, Mailtext, True, False
End Sub
Sub SendNotesMail(Subject As String, Attachment As Variant, Recipient As Variant, ccRecipient _
As String, bccRecipient As String, BodyText As String, SaveIt As Boolean, Entwurf As Boolean)
Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim EmbedObj As Object
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & _
".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Not (Maildb.IsOpen) Then
Maildb.OPENMAIL
End If
Set MailDoc = Maildb.CREATEDOCUMENT
With MailDoc
.Form = "Memo"
.sendto = Recipient
.copyto = ccRecipient
.BlindCopyTo = bccRecipient
.Subject = Subject
.Body = BodyText
.SAVEMESSAGEONSEND = SaveIt
If Attachment "" Then
Set AttachME = .CREATERICHTEXTITEM(Attachment)
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
.CREATERICHTEXTITEM (Attachment)
End If
If Entwurf Then
Call .Save(True, True)
Else
.PostedDate = Now()
.send 0, Recipient
End If
End With
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Sub