AW: Arbeitsmappe über Lotus Notes 8.5 versenden
09.02.2012 15:54:30
Rudi
Hallo,
Sub Mailen()
SendMail "Ein Test", "Helmut_Oberle@kabelbw.de;anderer@testmail.com","" ,"" ,"" , _
ThisWorkbook.FullName
End Sub
Function SendMail( _
ByVal EMailSubject As String, ByVal EMailSendTo As String, _
ByVal EMailCCTo As String, ByVal EMailBCCTo As String, _
ByVal EMailText As String, ByVal EMailAttachment As String)
Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Dim Msg As String
On Error GoTo SendMailError
Set objNotesSession = CreateObject("Notes.NotesSession")
Set objNotesMailFile = objNotesSession.GETDATABASE("", "")
objNotesMailFile.OPENMAIL
Set objNotesDocument = objNotesMailFile.CREATEDOCUMENT
Set objNotesField = objNotesDocument.APPENDITEMVALUE("Subject", EMailSubject)
Set objNotesField = objNotesDocument.APPENDITEMVALUE("SendTo", Split(EMailSendTo, ";"))
If EMailCCTo "" Then
Set objNotesField = objNotesDocument.APPENDITEMVALUE("CopyTo", Split(EMailCCTo, ";"))
End If
If EMailBCCTo "" Then
Set objNotesField = objNotesDocument.APPENDITEMVALUE("BlindCopyTo", Split(EMailBCCTo, ";"))
End If
Set objNotesField = objNotesDocument.CREATERICHTEXTITEM("Body")
If EMailText "" Then
objNotesField.APPENDTEXT EMailText
End If
If EMailAttachment "" Then
objNotesField = objNotesField.EMBEDOBJECT(1454, "", EMailAttachment)
End If
objNotesDocument.Send (0)
Set objNotesSession = Nothing
Set objNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing
SendMail = True
Exit Function
SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
SendMail = False
End Function
Gruß
Rudi