AW: Function-Funktion?
25.08.2004 09:39:09
Frederic
Hi,
danke für die Antwort, dass dachte ich auch, aber bei diesem Code funktionierts leider net:
Sub SendLotusNots()
Function SendNotesMail(strMessage As String, _
strSubject As String, _
strSendTo As String, _
lngLogo As Long, strAttachment As String)
On Error GoTo NotesMail_Err
Dim lnSession As Object
Dim lnDatabase As Object
Dim lnDocument As Object
Dim lnRTStyle As Object
Dim lRTItem As Object
Dim lnATTACHMENT As Object
Dim sMessage As String
Dim lLogo As Long
''start a notes session...
Set lnSession = CreateObject("Notes.Notessession")
''create a new style object to control t
' he appearance of the message
Set lnRTStyle = lnSession.CreateRichTextStyle
''get the current database...
Set lnDatabase = lnSession.GetDatabase("", "")
lnDatabase.OpenMail
''create a new document
Set lnDocument = lnDatabase.CreateDocument
''create a new NotesRichTextItem object
' in which we can store,
''and format the main message body in Ri
' chText format
Set lnRTItem = lnDocument.CreateRichTextItem("Body")
If strAttachment <> "" Then
Set lnATTACHMENT = lnRTItem.EMBEDOBJECT _
(1454, "", strAttachment, "Sample")
End If
sMessage = "Mail sent: " & Date & " " & Time & vbCrLf & vbCrLf & _
strMessage
''format the message
lnRTStyle.NotesFont = 4 ''Courier
lnRTStyle.Bold = True
lnRTStyle.NotesColor = 2 ''red
Call lnRTItem.AppendStyle(lnRTStyle)
Call lnRTItem.AppendText(sMessage)
'Call lnRTItem.AddNewLine(1)
''logo values are between 0 and 31
lLogo = lngLogo
If lLogo < 0 Or lLogo > 31 Then
lLogo = 0
End If
''replace some of the fields that we nee
' d...
With lnDocument
''who we want to send to...
''recipient
.ReplaceItemValue "frederic.anders@schwan-stabilo.com", strSendTo
''subject
.ReplaceItemValue "Subject", strSubject
''body - non RichText
'.ReplaceItemValue "Body", "The body of
' the message!"
''set the logo! (letter head)
.ReplaceItemValue "Logo", "StdNotesLtr" & Trim$(Str$(lLogo))
''send the message
.Send False
End With
Set lRTItem = Nothing
Set lnRTStyle = Nothing
Set lnDocument = Nothing
Set lnDatabase = Nothing
Set lnSession = Nothing
MsgBox "Mail was sent!", vbInformation, _
strSendTo
Exit Function
NotesMail_Err:
MsgBox Err.Description, _
vbExclamation, _
"Send mail error! (" & Trim$(Str$(Err)) & ")"
SendNotesMail "Hello! This is an email message! With an attachment", _
"Test Lotus Notes Email - Attachment test", _
"frederic.anders@schwan-stabilo.com", 0, "C:\autoexec.bat"
End Function
End Sub