' **************************************************************
'  Modul:  mdlLotusNotes  Typ = Allgemeines Modul
' **************************************************************
Option Explicit
 
Sub lotus()
 ' Hier sind VBA 6 Funktionalitäten (Split Replace)
 ' also in dieser Version ab E 2000
 ' Peter Haserodt 2004 - zusammengetragen aus dem Net '
 ' und zusammengeschustert ;-)
 ' Für jeden auf eigene Gefahr und eigenem Verständis
 ' ############################################################
 ' Die Variablen für Empfänger und Anhang sind richtig zu belegen
 ' ############################################################
 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
 Dim AttachMe As Object, DerAnhang As Object
 Dim user As String, server As String
 Dim mailfile As String, sBlindKopie As String
 Dim vAn As Variant, vCopy As Variant
 Dim 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 = "Email1 ; 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 = "Ein Pfad zu einer Datei" ' 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
 user = session.UserName
 server = session.GetEnvironmentString("MailServer", True)
 mailfile = session.GetEnvironmentString("MailFile", True)
 Set db = session.getdatabase(server, 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
 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