ueber Excel email mit Lotus Notes versenden
Alfonso
ich habe mit unten stehenden VBA-Code bis jetzt problemlos Mails von Excel (mit Anhang) an einen Empfänger versandt.
Jetzt sollen zusätzlich noch 2 weitere Empfänger dieses Mail (mit Anhang) erhalten.
Ich habe mit verschiedenen Varianten experimentiert. Das größte Problem bereitet mir, dass die 2 weiteren Empfänger nicht die Absendeadresse sehen.
Alle 3 Empfängeradressen nehme ich aus 3 verschiedenen Excelzellen.
(Ich habe den Code etwas abgekürzt dargestellt).
Wie muss ich den Code ändern, dass die Anforderung erfüllt wird.
Vielen Dank im voraus für die Hilfestellung.
Helmut
Sub DateiSpeichern_Mailsenden()
Dim Pfad As String
Dim PfadDatName As String
Dim Datname As String
Dim Zeit As String
Dim Schluessel As Integer
Dim Betreff As String
SendMail Datname, MailAdresse, "", "", "", _
ThisWorkbook.FullName
Range("C2").Select
Msg = "Die E-Mail wurde erfolgreich versendet!"
MsgBox Msg, vbInformation, "Notesmail versenden..."
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
Function SendMail( _
ByVal EMailSubject As String, ByVal EMailSendTo As String, _
ByVal EMailCCTo As String, ByVal EMailBCCTo As String, _
ByVal EMailText As String, ByVal EMailAttachment As String)
Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Dim Msg As String
On Error GoTo SendMailError
Set objNotesSession = CreateObject("Notes.NotesSession")
Set objNotesMailFile = objNotesSession.GETDATABASE("", "")
objNotesMailFile.OPENMAIL
Set objNotesDocument = objNotesMailFile.CREATEDOCUMENT
Set objNotesField = objNotesDocument.APPENDITEMVALUE("Subject", EMailSubject)
Set objNotesField = objNotesDocument.APPENDITEMVALUE("SendTo", Split(EMailSendTo, ";"))
If EMailCCTo "" Then
Set objNotesField = objNotesDocument.APPENDITEMVALUE("CopyTo", Split(EMailCCTo, ";"))
End If
If EMailBCCTo "" Then
Set objNotesField = objNotesDocument.APPENDITEMVALUE("BlindCopyTo", Split(EMailBCCTo, ";") _
)
End If
Set objNotesField = objNotesDocument.CREATERICHTEXTITEM("Body")
If EMailText "" Then
objNotesField.APPENDTEXT EMailText
End If
If EMailAttachment "" Then
objNotesField = objNotesField.EMBEDOBJECT(1454, "", EMailAttachment)
End If
objNotesDocument.SAVEMESSAGEONSEND = True
objNotesDocument.PostedDate = Now
objNotesDocument.Send (0)
Set objNotesSession = Nothing
Set objNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing
SendMail = True
Exit Function
SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
SendMail = False
End Function
Anzeige