PDF als Mail Anhang in Lotus Noes

Sub druck()
'Blatt Drucken und Versionsnummer um eins hoch zählen
Sheets("WKZ").Select
ActiveSheet.Unprotect "wkz"
[C2] = [C2] + 1 'Versionsnummer um 1 hochzählen
ActiveWindow.SelectedSheets.PrintOut _
Copies:=1, Collate:=True 'Drucken
'Blatt Speichern
ChDrive "C"
ChDir "C:\WKZ Backup\"
DName = [E2]
'Blatt als PDF in Zielordner speichern
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=DName & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Sheets("WKZ").Protect "wkz"
'

Sub SendWithLotus()
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object
Dim stSubject As Variant, stAttachment As String
Dim vaRecipient As Variant, vaMsg As Variant
Const EMBED_ATTACHMENT As Long = 1454
Const stTitle As String = "Status Active workbook"
Const stMsg As String = "The active workbook must first be saved " & vbCrLf _
& "before it can be sent as an attachment."
'Check if the active workbook is saved or not
'If the active workbook has not been saved at all.
If Len(ActiveWorkbook.Path) = 0 Then
MsgBox stMsg, vbInformation, stTitle
Exit Sub
End If
'If the changes in the active workbook has been saved or not.
ActiveWorkbook.Save
'If ActiveWorkbook.Saved = False Then
'If MsgBox("Möchten Sie die Datei speichern bevor die e mail versendet wird?", _
'  vbYesNo + vbInformation, stTitle) = vbYes Then _
' ActiveWorkbook.Save
' End If
'Get the name of the recipient from the user.
'==========================================geändert=====================================
'Do
'vaRecipient = Application.InputBox( _
'Prompt:="Please add the name of the recipient such as:" & vbCrLf _
'& "excel@microsoft.com or just the name if it's internally.", _
'Title:="Recipient", Type:=2)
'Loop While vaRecipient = ""
'==========================================geändert=====================================
vaRecipient = "test@test.de"
'If the user has canceled the operation.
If vaRecipient = False Then Exit Sub
'Get the message from the user.
'==========================================geändert=====================================
'Do
'vaMsg = Application.InputBox( _
'   Prompt:="Please enter the message such as:" & vbCrLf _
'  & "Enclosed please find the weekly report.", _
'  Title:="Message", Type:=2)
'Loop While vaMsg = ""
'===========================================geändert======================================
vaMsg = "Werkzeugstatus wurde aktuallisiert auf Laufwerk P:Werkzeuge/Statusbericht "
'If the user has canceled the operation.
If vaMsg = False Then Exit Sub
'Add the subject to the outgoing e-mail which also can be retrieved from the users
'in a similar way as above.
'stSubject = "Weekly report"
stSubject = "Werkzeug Statusbericht "
'Retrieve the path and filename of the active workbook.
stAttachment = ActiveWorkbook.FullName
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
'Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
'Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipient
.CopyTo = ("testmail@test.com, testmail2@test.com, testmail3@test.com")
.Subject = stSubject
.BlindCopyTo = ("testmail@test.com, testmail2@test.com, testmail3@test.com")
'.BlindCopyTo = ("testmail@mail.com", "testmail2@mail.com", "testmail3@testmail.com")
.Body = vaMsg
.SaveMessageOnSend = True
End With
'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, vaRecipient
End With
'Release objects from the memory.
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
'Activate Excel for the user.
AppActivate "Microsoft Excel"
MsgBox "Die e-mail wurde erfolgreich erstellt und versendet .", vbInformation
Sheets("WKZ").Select
ActiveSheet.Protect "wkz"
End Sub