' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub sendActiveWorkbook()
Dim strReceiver As String, strSubject As String
Dim strBody As String, strAttach As String
If ThisWorkbook.Name Like "*.xls*" Then
If Not ThisWorkbook.Saved Then
If MsgBox("Diese Datei enthält ungespeicherte Daten!" & vbLf & vbLf & _
"Soll die Datei vor dem Senden gespeichert werden?", vbQuestion + _
vbYesNo + vbDefaultButton1, "Hinweis") = vbYes Then ThisWorkbook.Save
End If
strReceiver = "try.to@guess.it" 'Empfängeradresse
strSubject = "Hallo Du!"
strBody = "Hallo," & vbLf & vbLf & "hier die gewünschte Datei." & vbLf & vbLf & "LG"
strAttach = ThisWorkbook.FullName 'aktuelle Datei
SendMail_With_LotusNotes strBody, strSubject, strReceiver, FileToSend:=strAttach
Else
MsgBox "Diese Datei wurde noch nicht gespeichert!" & vbLf & vbLf & _
"Senden abgebrochen!", vbInformation, "Hinweis"
End If
End Sub
Sub SendMail_With_LotusNotes(Body As String, Subject As String, sendTo As String, Optional sendToCC _
As String, Optional sendToBC As String, Optional FileToSend As String)
Dim objSession As Object, objDB As Object, objDocument As Object
Dim objRTItem As Object, objAttachment As Object, objFile As Object
Dim strUser As String, strServer As String, strFile As String
Dim strTO() As String, strCC() As String, strBC() As String
On Error GoTo ErrExit
strTO = Split(sendTo, ";")
If Len(sendToCC) Then strCC = Split(sendToCC, ";")
If Len(sendToBC) Then strBC = Split(sendToBC, ";")
Set objSession = CreateObject("notes.notessession")
strUser = objSession.UserName
strServer = objSession.GetEnvironmentString("MailServer", True)
strFile = objSession.GetEnvironmentString("strFile", True)
Set objDB = objSession.getdatabase(strServer, strFile)
Set objDocument = objDB.createdocument()
objDocument.Form = "Memo"
objDocument.sendTo = strTO
If Len(sendToCC) > 0 Then objDocument.CopyTo = strCC
If Len(sendToBC) > 0 Then objDocument.BlindcopyTo = strBC
objDocument.Subject = Subject
Set objRTItem = objDocument.CREATERICHTEXTITEM("body")
Call objRTItem.APPENDTEXT(Body)
objDocument.SAVEMESSAGEONSEND = True
objDocument.PostedDate = Now
If FileToSend <> "" Then
Set objAttachment = objDocument.CREATERICHTEXTITEM("Attachment")
Set objFile = objAttachment.EMBEDOBJECT(1454, "", FileToSend, "Attachment")
End If
Call objDocument.Send(False)
ErrExit:
With Err
If .Number <> 0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & _
IIf(Erl > 0, "In Zeile " & Erl & vbLf & vbLf, "") & _
.Description & vbLf & vbLf & "In Prozedur (SendMail_With_LotusNotes) in Modul Modul1", _
vbExclamation, "Fehler in Modul1 / SendMail_With_LotusNotes"
End With
Set objRTItem = Nothing
Set objAttachment = Nothing
Set objFile = Nothing
Set objDB = Nothing
Set objDocument = Nothing
Set objSession = Nothing
End Sub