Mail über Lotus Notes versenden
Armin
ich verwende untenstehenden VBA-Code zum Versenden von E-Mail aus Excel über Lotus Notes. Soweit funktioniert das alles auch prima. Die E-Mail wird in Lotus-Notes erzeugt und steht zum Absenden bereit.
Ein Problem liegt allerdings vor. Der Mail-Body, also der Haupttext der E-Mail wird nicht eingetragen!
Hat jemand eine Idee, woran das liegen könnte?
Vielen Dank
Armin
Code:
Sub LotusNotesMailSend()
Dim sText As String, sEmpfang As String, sBetrifft As String
Dim Session As Object, db As Object, doc As Object, rtobject As Object
Dim rtitem As Object, sKopie As String, AttachME As Object, DerAnhang As Object
Dim user As String, server As String, mailfile As String, sBlindKopie As String
Dim vAn As Variant, vCopy As Variant, vBlind As Variant, sAnhang As String
'On Error GoTo Fehler
sText = "Test " & vbCrLf & "Zweite Zeile" ' Testtext
sText = Replace(sText, vbCrLf, Chr(10)) ' Zeilenumbrüche ändern
sEmpfang = "test@test.com ; Email2 " ' Einträge durch " ; " getrennt
sBetrifft = "Mein Betreff" ' die Betreffzeile
'sKopie = "Email1 ; Email2 " ' Einträge durch " ; " getrennt
'sBlindKopie = "Email1 ; Email2 " ' Einträge durch " ; " getrennt
vAn = Split(sEmpfang, " ; ") ' Empfänger Array
sAnhang = "X:\test.txt" ' Muss natürlich richtig gesetzt werden
If Len(sKopie) > 0 Then vCopy = Split(sKopie, " ; ") 'cc Array
If Len(sBlindKopie) > 0 Then vBlind = Split(sBlindKopie, " ; ") 'bcc Array
Set Session = CreateObject("notes.notessession") ' Notes muss gestartet sein denke ich
user = Session.UserName
server = Session.GetEnvironmentString("MailServer", True)
mailfile = Session.GetEnvironmentString("MailFile", True)
'Set db = session.GETDATABASE(server, mailfile)
Set db = Session.GETDATABASE("", mailfile)
Set doc = db.CREATEDOCUMENT()
doc.Form = "Memo"
doc.sendto = vAn ' an array
If Len(sKopie) > 0 Then doc.CopyTo = vCopy 'cc Array
If Len(sBlindKopie) > 0 Then doc.blindcopyto = vBlind 'bcc Array
doc.Subject = sBetrifft ' die Betreffzeile
'** Mail-Text eintragen
Set rtitem = doc.CREATERICHTEXTITEM("Body")
Call rtitem.APPENDTEXT(sText)
doc.SAVEMESSAGEONSEND = True
doc.PostedDate = Now
If sAnhang "" Then
Set AttachME = doc.CREATERICHTEXTITEM("Attachment")
Set DerAnhang = AttachME.EMBEDOBJECT(1454, "", sAnhang, "Attachment")
End If
Call doc.SEND(False)
Aufraeumen:
On Error Resume Next
Set rtitem = Nothing
Set AttachME = Nothing
Set DerAnhang = Nothing
Set db = Nothing
Set doc = Nothing
Set Session = Nothing
Exit Sub
Fehler:
Resume Aufraeumen
End Sub