Lotus Notes VBA ,Musseingabe

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)  funktioniert  in  _
der Arbeitsmappe , wollte den code nun in den Sub SendWithLotus() einbinden leider komme ich da nicht zurecht .
Vielleicht habt ihr ja ein paar ideen.
Danke Rene
Code
'The procedure for executing the main task:
Sub SendWithLotus()
'===========================================Abfragen ob Zellen gefüllt sind ==================== _
'beim beforeSavein der Arbeitsmappe funktioniert es wie gewünscht ,wie kann der code  _
dahingehend geändert werden
'das Mail versenden ebenfalls nur möglich ist wenn die entsprechenden Zellen gefüllt sind?
'=============================================================================================== _
'

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Zelle As Range
Dim zähler As Integer
ActiveSheet.Unprotect
For Each Zelle In Range("Pflichtfelder").Cells
If Zelle = "" Then
Zelle.Interior.ColorIndex = 3
zähler = zähler + 1
Else
ActiveSheet.protect DrawingObjects:=False, Contents:=False, Scenarios:=False
Zelle.Interior.ColorIndex = xlNone
End If
Next Zelle
If zähler = 0 Then
'ActiveSheet.print
'ActiveWorkbook.Save
Else
MsgBox "Bitte alle Felder ausfüllen!", vbInformation, "Stammdatenblatt"
End If
'End Sub

'=================================================================================================

'The procedure for executing the main task:

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.

If ActiveWorkbook.Saved = False Then

ActiveSheet.Unprotect

For Each Zelle In Range("Pflichtfelder").Cells

If Zelle = "" Then

Zelle.Interior.ColorIndex = 3

zähler = zähler + 1

Else

ActiveSheet.protect DrawingObjects:=False, Contents:=False, Scenarios:=False

Zelle.Interior.ColorIndex = xlNone

End If

Next Zelle

If zähler = 0 Then

'ActiveSheet.print

'ActiveWorkbook.Save

Else

MsgBox "Bitte alle Felder ausfüllen!", vbInformation, "Stammdatenblatt"

End If

'ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True

If MsgBox("Do you want to save the changes before sending?", _

vbYesNo + vbInformation, stTitle) = vbYes Then _

ActiveWorkbook.Save

End If

'Get the name of the recipient from the user.

Do

vaRecipient = "test@test.com"

'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 = ""

'If the user has canceled the operation.

If vaRecipient = False Then Exit Sub

'Get the message from the user.

Do

vaMsg = "Bitte Lieferanten anlegen"

'vaMsg = Application.InputBox( _

Prompt:="Please enter the message such as:" & vbCrLf _

& "Enclosed please find the weekly report.", _

Title:="Message", Type:=2)

Loop While vaMsg = ""

'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 = "Lieferanten anlegen Werk 7350 "

'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

.Subject = stSubject

.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 "The e-mail has successfully been created and distributed.", vbInformation

End Sub