Manmeet S Ahluwalia 6.Mar.12 06:54 AM a Web browser Applications Development7.0.2Windows XP
Sub Click(Source As Button)
%REM
This code is used for sending mails
%END REM
On Error Goto e
Dim maildb As notesdatabase
Dim ndc As NotesDocumentCollection
Dim doc As notesdocument, MailDoc As notesdocument, tempdoc As NotesDocument
Dim rtitem As NotesRichTextItem ' Richtextitem Item
Dim rttable As NotesRichTextTable ' For getting the handle of the table in the Richtextitem item
Dim rtStyle As NotesRichTextStyle ' For adding formatting rules to the table i.e. font , color etc.
Dim rtpstyles(1 To 4) As NotesRichTextParagraphStyle ' For adding margins , alignment etc.
Dim TopColObj As NotesColorObject , AltColObj As NotesColorObject 'Color objects defined for row coloring
Dim prefix As String, PersonalSig As String, FileContentType As String
Dim uidoc As notesuidocument, uimaildoc As NotesUIDocument
Dim profiledoc As notesdocument, mailProfile As NotesDocument
Dim ws As New notesuiworkspace
Dim mime As NotesMimeEntity
Dim stream As NotesStream
Dim item As NotesRichTextItem
Set uidoc=ws.currentdocument
Set doc=uidoc.document
Dim db As notesdatabase
Dim session As New notessession
Set db=session.currentdatabase
Set profiledoc=db.getprofiledocument("profile")
Set maildb = New NotesDatabase( "", "" )
maildb.OpenMail
Set MailDoc = maildb.CreateDocument
MailDoc.Form = "Memo"
prefix$ = profiledoc.EmailSubjectPrefix(0)
If Len(prefix$) > 0 Then
prefix$ = prefix$ & " "
End If
MailDoc.Subject = "Test Subject"
Set rtitem = New NotesRichTextItem( MailDoc , "Body" )
' For setting the Margins and Alignments of the 4 columns
Call rtitem.AppendDocLink( doc, "Link")
rtitem.Update
Set mailProfile = MailDb.GetProfileDocument("CalendarProfile")
PersonalSig = mailProfile.Signature( 0 )
If mailProfile.SignatureOption( 0 ) = "1" Then
rtitem.AddNewline( 2 )
Call rtitem.AppendText( PersonalSig )
rtitem.Update
maildoc.Save True, False
Else
Set mime = maildoc.CreateMIMEEntity( "PersonalSignature" )
Set stream = session.CreateStream
Call stream.Open( PersonalSig )
FileContentType = GetContentTypeFromFile( PersonalSig )
Call mime.SetContentFromBytes(stream, _
FileContentType , ENC_IDENTITY_BINARY)
Call stream.Close
maildoc.Save True, False
Set item = maildoc.GetFirstItem( "PersonalSignature" )
rtitem.AddNewline( 2 )
Call rtitem.AppendRTItem( item )
rtitem.Update
End If
Set uimaildoc = ws.EditDocument( True, maildoc, False, , False, True )
Exit Sub
e:
Msgbox Error & Erl
End Sub
************** GetContentTypeFromFile ****************
Function GetContentTypeFromFile( FileName As String )As String
Dim ContentType As String, FileExt As String
FileExt = Strrightback( FileName, "." )
Select Case FileExt
Case "txt" : ContentType = "plain/text"
Case "gif" : ContentType = "image/gif"
Case "jpg" : ContentType = "image/jpeg"
Case "bmp" : ContentType = "image/bmp"
Case "html" : ContentType = "text/html;charset=UTF-8"
End Select
GetContentTypeFromFile = ContentType
End Function
Return to top
Print this page
