Dim Empfaenger As Variant
Dim rtitem As Object
Dim EmbeddedObject As Object
Dim Tosenden
Dim CCsenden
Dim BCCsenden
Dim Betreff As String
Dim Text As String
Dim Cells As Range
Dim Linkanhang As String
Select Case Schweregrad.Value
Case "1"
With Worksheets("Emailverteiler")
Linkanhang = .Range("A1")
Dateianhang = Linkanhang
If ActiveWorkbook.Worksheets("Eingabe Alert").SDE.Value = True Then
Tosenden = .Range("A2")
If ActiveWorkbook.Worksheets("Eingabe Alert").SQE.Select Then
Tosenden = .Range("A5")
etc.
End If
Betreff = .Range("A3") & (" Schweregrad: 1")
Text = .Range("A4")
End With
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 in Lotus Notes anmelden!", vbInformation + _
vbOKOnly
Exit Sub
End If
Set NotesDoc = NotesDB.CreateDocument
With NotesDoc
.Form = "Memo"
.Subject = Betreff
.sendto = Tosenden
.copyto = CCsenden
.blindcopyto = BCCsenden
.body = Text
.DeliveryReport = "B"
.Importance = "1"
.SAVEMESSAGEONSEND = True
.ReturnReceipt = "1"
.Sign = "1"
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
End Select