Hallo Experten !
Ein begeisterter, aber leider sehr unwissender VBA-Nutzer hofft mal wieder auf Eure Unterstützung.
Dank freundllicher Hilfe dieses Forums habe ich eine Automatik zur Verfügung, um aus einem Excel-Arbeitsblatt E-Mails per Lotus Notes zu versenden. Unter anderem werden die Empfänger von Mail, Mailkopie und Blindkopie aus den Zellen A3, B3 und C3 ausgelesen.
Diese Systematik habe ich um ein Auswahlmenü erweitert. Auf einer Adressliste werden mir Mailadressen angezeigt, die ich per Button in die Zellen A3, B3 oder C3 hineinkopiere.
Wenn ich allerdings mehrere Mailempfänger auswähle, werden die Empfänger jeweils zusammen in der entsprechenden Zelle nacheinander durch Komma getrennt aufgeführt. Also habe ich in der Zelle A3, B3 oder C3 jeweils mehrere Emailadressen, wie z.B.
max.mustermann@web.de, erwin.mustermann@web.de, fritz.mustermann@web.de
Offensichtlich müssen die einzelnen Mailadressen innerhalb der Zelle in einem Array o.ä. zusammengefasste werden ...
Wie muß ich bitte das Sendemakro verändern, damit die Mail an alle alle Emailadressen in den Zellen
versendet wird ?
Vielen Dank für Eure Lösungsvorschläge !
Viele Grüße
Wolfgang
Mein Sendemakro:
Dim Empfaenger As String
Dim rtitem As Object
Dim EmbeddedObject As Object
Dim Tosenden As String
Dim CCsenden As String
Dim BCCsenden As String
Dim Betreff As String
Dim Text2 As String
Dim Linkanhang As String
Linkanhang = Worksheets("Tabelle1").Range("G3") 'anpassen
DATEIANHANG = Linkanhang
Tosenden = Worksheets("Tabelle1").Range("A3") 'anpassen
CCsenden = Worksheets("Tabelle1").Range("B3") 'anpassen
BCCsenden = Worksheets("Tabelle1").Range("C3") 'anpassen
Betreff = Worksheets("Tabelle1").Range("D3") 'anpassen
Text = Worksheets("Tabelle1").Range("E3") + Chr(10) + Chr(10) + Chr(10) + Sheets("Signatur").[a1] 'anpassen
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
Set NotesDoc = NotesDB.CREATEDOCUMENT
With NotesDoc
.Form = "Memo"
.Subject = Betreff
.sendto = Tosenden
.CopyTo = CCsenden
.bcopyto = BCCsenden
.body = Text
.DeliveryReport = "B"
.Importance = "2"
.SAVEMESSAGEONSEND = True
.ReturnReceipt = "1"
.Sign = "1"
' 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
MsgBox "Die Mail wurde versendet !"
Exit_Mail_Click:
Exit Sub
Err_Mail_Click:
MsgBox Err.Description
Resume Exit_Mail_Click