Classe Mail 2.0

[oguruma]

Bonjour,

Vous trouverez dans les posts suivant une classe Mail 2.0.

Elle permet de gérer la construction de messages anonymes et non anonymes.

Cette question avait été abordée et souhaitée dans le forum Développement.
J'avais donné quelques pistes au posteur. Je crois qu'il a eu quelques difficultés de réalisation et il a donc revu sa manière de faire.

De mon côté, je n'étais plus trop satisfait de ma classe Mail 1.0 qui est était assez limitative. Je l'ai donc revu et corrigé.

Avant de poster, quelques notes d'explications.

Le constructeur de la classe permet de spécifier :
1) le courrier est anonyme
2) de forcer le création du message sur la mail.box du serveur
3) et le cas échéant de préciser un serveur de messagerie hébergeant la mail.box

En effet la localisation de la mail.box est fondée sur l'emplacement de la base courrier de l'utilisateur (local ou serveur). Cependant si l'utilisateur a sa base courrier en local on peut dans ce créer le message dans une mail.box sur serveur. Par défaut ce sera le serveur de l'application. Or si celle-ci est aussi installée en local, on lui précisera le nom d'un serveur de messagerie (3ème paramètre).

Je vous invite à lire la procédure init appelée par le constructeur pour mieux comprendre tout ceci.

Cette classe dispose de toutes les propriétés de la messagerie y compris les 'mood'.
Vous pouvez en plus des présentations classiques (gras, souligné, italic) jongler avec les alignements du texte et les interlignes.

Vous pouvez y insérer des pièces jointes (comme la 1.0).

Pour ceux qui ont connu la v 1.0, la gestion des destinataires est désormais différente.

En effet vous disposez des 3 propriétés pour SendTo, CopyTo, BlindCopyTo.

Ces propriétés initialisent et écrasent éventuellement les destinataires définis au préalable.

Vous disposez en revanche des méthodes AddSendTo, AddCopyTo et AddBlindCopyTo. La traduction donne la fonction de chacune de ces méthodes.

Vous pouvez donc soit passer par les propriétés soit par les méthodes. Les propriétés demandent par contre un tableau en paramètres tandis que les méthodes acceptent soit un tableau soit une chaine de caractères.

Vous disposez aussi d'une méthode ou insérer des liens-doc et y recopier des objets textes riches.

Je vous laisse découvrir le code et les exemples qui font fournis dans la base.

Bonne utilisation, vos remarques, critiques, ajouts. etc. sont les bienvenus.

[oguruma]

'//==================================================================================
'// Classe : Mail
'// Objet : Créer un courrier dans mail.box
'// Version : Initiale
'// Date : 04.06.2006
'//==================================================================================

Public Class Mail
'//==============================
'// Indicateurs d'erreur runtime
'//==============================
Private m_sError As String
Private m_iError As Integer
Private m_iErrorLine As Integer
Private m_bError As Boolean
Private m_sProc As String
Private m_sErrorMsg As String
'//==============================
'// Mode trace
'//==============================
Private m_Trace As Boolean
'//==============================
'// Handle composant le message
'//==============================
Private hSession As NotesSession
Private hCurrentDatabase As NotesDatabase
Private hMailServer As String
Private hDbMailBox As NotesDataBase
Private hDbOpenMail As NotesDatabase
Private hMailDoc As NotesDocument
Private hRTBody As Variant
Private hRS As Variant
Private hStyle As NotesrichTextParagraphStyle
Private hItemSendTo As NotesItem
Private hItemCopyTo As NotesItem
Private hItemBlindCopyTo As NotesItem
Private bBold As Boolean
Private bItalic As Boolean
Private bUnderline As Boolean
'// hColor : COLOR_BLACK, COLOR_BLUE, COLOR_CYAN, COLOR_DARK_BLUE
'// COLOR_DARK_CYAN, COLOR_DARK_GREEN, COLOR_DARK_MAGENTA
'// COLOR_DARK_RED, COLOR_DARK_YELLOW, COLOR_GRAY, COLOR_GREEN
'// COLOR_LIGHT_GRAY, COLOR_MAGENTA, COLOR_RED,COLOR_WHITE, COLOR_YELLOW
Private hColor As Variant
Private hFonteSize As Integer
'// hFonte : FONT_COURIER, FONT_HELV, FONT_ROMAN, STYLE_NO_CHANGE
Private hFonte As Integer
'// hAlignment ALIGN_CENTER, ALIGN_FULL, ALIGN_LEFT, ALIGN_NOWRAP, ALIGN_RIGHT
Private hAlignment As Integer
'// hInterlinesSpacing : SPACING_DOUBLE, SPACING_ONE_POINT_25
'// SPACING_ONE_POINT_50, SPACING_ONE_POINT_75, SPACING_SINGLE
Private hInterlinesSpacing As Integer
Private hSubject As String
Private hSendTo As Variant
Private hCopyTo As Variant
Private hBlindCopyTo As Variant
Private hRecipients As Variant
Private hPrincipal As String
Private hReplyTo As String
Private hFrom As String
'// hDeliveryPriority : Low|L, Normal|N, High|H
Private hDeliveryPriority As String
Private hReturnReceipt As Boolean
Private hSign As Boolean
Private hEncrypt As Boolean
Private hPreventDelegate As Boolean
Private hPreventCounter As Boolean
Private hBroadcast As Boolean
'// hDeliveryReport : None|N, Only on failure|B, Confirm delivery|C, Trace entire path|T
Private hDeliveryReport As String
Private hAnonyme As Boolean
'// hImportance : Low|3, Normal|2, High|1
Private hImportance As String
'// SMTPEncoding : Accept Administrator's default|0, MIME (Base64)|B, Quoted Printable|Q, UUencode|U
Private hSMTPEncoding As String
'// hKeepPrivate : Prevent copying|1
Private hKeepPrivate As String
Private hReplyDate As Variant
Private hExpireDate As Variant
'// htmpSenderTag : Normal|N, Personal|P, Confidential|C, Private|R, Thank You!|T, Flame|F
'// htmpSenderTag : Good Job!|G, Joke|J, FYI|Y, Question|Q, Reminder|M
Private htmpSenderTag As String

'//==================================
'// Définition des propriétés
'//==================================
Property Set Italic As Boolean
bItalic=Italic
Call SetItalic(bItalic)
End Property

Property Set Underline As Boolean
bUnderline=Underline
Call SetUnderline(bUnderline)
End Property

Property Set Fonte As Integer
hFonte=Fonte
Call SetFont(hFonte)
End Property

Property Set bold As Boolean
bBold=Bold
Call SetBold(bBold)
End Property

Property Set Color As Variant
hColor=Color
Call SetColor(hColor)
End Property

Property Set Alignment As Integer
hAlignment=Alignment
Call SetAlignment(hAlignment)
End Property

Property Set InterlinesSpacing As Variant
hInterlinesSpacing=InterlinesSpacing
Call SetInterlinesSpacing(hInterlinesSpacing)
End Property

Property Set FontSize As Integer
hFonteSize=FontSize
Call SetFontSize(hFonteSize)
End Property

Property Set Subject As String
hSubject=Subject
End Property

Property Set SendTo As Variant
hSendTo=SendTo
End Property

Property Set CopyTo As Variant
hCopyTo=CopyTo
End Property

Property Set BlindCopyTo As Variant
hBlindCopyTo=BlindCopyTo
End Property

Property Set Principal As String
hPrincipal=Principal
End Property

Property Set ReplyTo As String
hReplyTo=ReplyTo
End Property

Property Set FromBy As String
hFrom=FromBy
End Property

Property Set DeliveryPriority As String
hDeliveryPriority=DeliveryPriority
End Property

Property Set ReturnReceipt As Boolean
hReturnReceipt=ReturnReceipt
End Property

Property Set Sign As Boolean
hSign=Sign
End Property

Property Set Encrypt As Boolean
hEncrypt=Encrypt
End Property

Property Set PreventDelegate As Boolean
hPreventDelegate=PreventDelegate
End Property

Property Set PreventCounter As Boolean
hPreventCounter=PreventCounter
End Property

Property Set Broadcast As Boolean
hBroadcast=Broadcast
End Property

Property Set DeliveryReport As String
hDeliveryReport=DeliveryReport
End Property

Property Set Importance As String
hImportance=Importance
End Property

Property Set SMTPEncoding As String
hSMTPEncoding=SMTPEncoding
End Property

Property Set KeepPrivate As String
hKeepPrivate=KeepPrivate
End Property

Property Set ReplyDate As Variant
hReplyDate=ReplyDate
End Property

Property Set ExpireDate As Variant
hExpireDate=ExpireDate
End Property

Property Set SenderTag As String
htmpSenderTag=SenderTag
End Property

Property Set Trace As Boolean
m_Trace=Trace
End Property

'//=========================================================
'// Constructeur
'//=========================================================
Sub new(bAnonym As Boolean, bForceToServer As Boolean,sDefaultServer As String )
Call init(bAnonym,bForceToServer,sDefaultServer)
End Sub

'//=========================================================
'// Passage à n lignes
'//=========================================================
Public Sub NewLine(iLines As Integer)
On Error Goto HANDLE_ERROR
Call hRTBody.AddNewLine(iLines)
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Définition du texte du message
'//=========================================================
Public Sub SetBody(vBody As Variant, bNewLine As Boolean)
On Error Goto HANDLE_ERROR

If Isarray(vBody) Then
Forall T In vBody
Call hRTBody.AppendText( T )
If bNewLine Then
Call hRTBody.AddNewLine(1)
End If
End Forall
Else
Call hRTBody.AppendText( vBody )
If bNewLine Then
Call hRTBody.AddNewLine(1)
End If
End If
If m_Trace Then
Call TraceMsg("Texte correctement ajoutés au message")
End If
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Ajouter d'un destinataire : SendTo
'//=========================================================
Public Sub AddSendTo(vSendTo As Variant)
On Error Goto HANDLE_ERROR
If Isarray(vSendTo) Then
Forall element In vSendTo
Call addElement(hSendTo,element)
End Forall
Else
Call addElement(hSendTo,vSendTo)
End If
If m_Trace Then
Call TraceMsg("Destinataires correctement ajoutés")
End If
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Ajouter d'un destinataire : CopyTo
'//=========================================================
Public Sub AddCopyTo(vCopyTo As Variant)
On Error Goto HANDLE_ERROR
If Isarray(vCopyTo) Then
Forall element In vCopyTo
Call addElement(hCopyTo,element)
End Forall
Else
Call addElement(hCopyTo,vCopyTo)
End If
If m_Trace Then
Call TraceMsg("Destinataires en copie correctement ajoutés")
End If
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Ajouter d'un destinataire : BlindCopyTo
'//=========================================================
Public Sub AddBlindCopyTo(vBlindCopyTo As Variant)
On Error Goto HANDLE_ERROR
If Isarray(vBlindCopyTo) Then
Forall element In vBlindCopyTo
Call addElement(hBlindCopyTo,element)
End Forall
Else
Call addElement(hBlindCopyTo,vBlindCopyTo)
End If
If m_Trace Then
Call TraceMsg("Destinataires en copie cachées correctement ajoutés")
End If
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Attachement de fichiers
'//=========================================================
Public Sub SetAttachedFiles(vAttachesFiles As Variant)
On Error Goto HANDLE_ERROR
If Isarray(vAttachesFiles) Then
Forall Attached In vAttachesFiles
If Trim$(Attached)<>"" Then
Call hRTBody.EmbedObject( EMBED_ATTACHMENT, "", Attached)
Call NewLine(1)
If m_Trace Then
Call TraceMsg("Fichier " & Attached & " correctement attaché")
End If
End If
End Forall
Else
Call hRTBody.EmbedObject( EMBED_ATTACHMENT, "", vAttachesFiles)
Call NewLine(1)
End If
If m_Trace Then
Call TraceMsg("Les fichiers ont été correctement attachés au message")
End If
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Positionnement d'un lien doc
'//=========================================================
Public Sub SetDocLink(Msg As String,DocLink As NotesDocument)
On Error Goto HANDLE_ERROR
Call hRTBody.AddNewLine(1)
Call hRTBody.AppendText( Msg )
Call hRTBody.AppendDocLink( DocLink, hMailDoc.Subject(0))
If m_Trace Then
Call TraceMsg("Lien doc correctement créé dans le message")
End If
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Ajout d'un objet
'//=========================================================
Public Sub AddRTItem(rtitem As Variant)
On Error Goto HANDLE_ERROR
Call hRTBody.AppendRTItem(rtitem)
If m_Trace Then
Call TraceMsg("Objet correctement ajouté au message")
End If
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Envoi du message
'//=========================================================
Public Sub Send(bSave As Boolean)
On Error Goto HANDLE_ERROR
Dim hLocalDocMail As NotesDocument
'// Construction du message
If Not BuildMail() Then
If hSession.IsOnServer Then
Call TraceMsg("Erreur pendant la construction du message")
Else
Msgbox "Erreur pendant la construction du message",16,Lsi_info(2)
End If
Exit Sub
End If
'// Doit-on sauvegarder le message dans la base active
If bSave Then
Set hLocalDocMail=New NotesDocument(hCurrentDatabase)
Set hLocalDocMail=hMailDoc
Call hLocalDocMail.Save(True,False)
If m_Trace Then
Call TraceMsg("Message sauvegardé dans la base actuelle")
End If
End If
'// Envoi du message - aiguillage
If hAnonyme Then
'// Déposé dans la mail.box
Call hMailDoc.Save(True,False)
Else
'// Envoyé à partir de la bas en cours d'utilisation
Call hMailDoc.Send(False)
End If
If m_Trace Then
Call TraceMsg("Message déposé dans la mailbox avec succès")
End If
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Construction du message
'//=========================================================
Private Function BuildMail() As Boolean
On Error Goto HANDLE_ERROR
Dim hNDT As NotesDateTime
If m_Trace Then
Call TraceMsg("Construction du message en cours...")
End If
Set hNDT=New NotesDateTime(Now)
If hAnonyme Then
Call hMailDoc.ReplaceItemValue("PostedDate", hNDT.LocalTime)
Call hMailDoc.ReplaceItemValue("From", hFrom)
If Not Isempty(hSendTo) Then
If Not BuildRecipients(hRecipients,hSendTo) Then
Call statusMsg("Erreur pendant la construction SendTo")
Exit Function
End If
End If
If Not Isempty(hCopyTo) Then
If Not BuildRecipients(hRecipients,hCopyTo) Then
Call statusMsg("Erreur pendant la construction hCopyTo")
Exit Function
End If
End If
If Not Isempty(hBlindCopyTo) Then
If Not BuildRecipients(hRecipients,hBlindCopyTo) Then
Call statusMsg("Erreur pendant la construction hBlindCopyTo")
Exit Function
End If
End If
Call hMailDoc.ReplaceItemValue("Recipients", hRecipients)
End If
Call hMailDoc.ReplaceItemValue("Subject", hSubject)
Call hMailDoc.ReplaceItemValue("Principal", hPrincipal)
Call hMailDoc.ReplaceItemValue("ReplyTo", hReplyTo)
Call hMailDoc.ReplaceItemValue("SendTo", hSendTo)
Call hMailDoc.ReplaceItemValue("CopyTo", hCopyTo)
Call hMailDoc.ReplaceItemValue("BlindCopyTo", hBlindCopyTo)
Call hMailDoc.replaceItemValue("DeliveryPriority",hDeliveryPriority)
Call hMailDoc.ReplaceItemValue("DeliveryReport", hDeliveryReport)
Call hMailDoc.ReplaceItemValue("Importance", hImportance)
Call hMailDoc.ReplaceItemValue("SMTPEncoding", hSMTPEncoding)
Call hMailDoc.ReplaceItemValue("$KeepPrivate", hKeepPrivate)
Call hMailDoc.ReplaceItemValue("ReplyDate", hReplyDate)
Call hMailDoc.ReplaceItemValue("ExpireDate", hExpireDate)
Call hMailDoc.ReplaceItemValue("SenderTag", htmpSenderTag)

If hReturnReceipt Then
Call hMailDoc.ReplaceItemValue("ReturnReceipt","1")
End If
If hSign Then
Call hMailDoc.ReplaceItemValue("Sign","1")
End If
If hEncrypt Then
Call hMailDoc.ReplaceItemValue("Encrypt","1")
End If
If hPreventDelegate Then
Call hMailDoc.ReplaceItemValue("PreventDelegate","1")
End If
If hPreventCounter Then
Call hMailDoc.ReplaceItemValue("PreventCounter","1")
End If
If hBroadcast Then
Call hMailDoc.ReplaceItemValue("Broadcast","1")
End If
If m_Trace Then
Call TraceMsg("Message créé avec succès")
End If
BuildMail=True
END_HANDLE_ERROR:
Exit Function
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Function

'//=========================================================
'// Texte en gras
'//=========================================================
Public Sub SetBold(isBold As Boolean)
On Error Goto HANDLE_ERROR
hRS.Bold=isBold
Call hRTBody.AppendStyle(hRS)
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Alignement du texte
'//=========================================================
Public Sub SetAlignment(Align As Integer)
On Error Goto HANDLE_ERROR
hStyle.Alignment = Align
Call hRTBody.AppendParagraphStyle(hStyle)
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Texte en souligné
'//=========================================================
Public Sub SetUnderline(isUnderline As Boolean)
On Error Goto HANDLE_ERROR
hRS.Underline=isUnderline
Call hRTBody.AppendStyle(hRS)
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub


'//=========================================================
'// Texte en italic
'//=========================================================
Public Sub SetItalic(isItalic As Boolean)
On Error Goto HANDLE_ERROR
hRS.Italic=isItalic
Call hRTBody.AppendStyle(hRS)
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Couleur du texte
'//=========================================================
Public Sub SetColor(vColor As Variant)
On Error Goto HANDLE_ERROR
hRS.NotesColor=vColor
Call hRTBody.AppendStyle(hRS)
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Taille de la police
'//=========================================================
Public Sub SetFontSize(iFontSize As Integer)
On Error Goto HANDLE_ERROR
hRS.FontSize=iFontSize
Call hRTBody.AppendStyle(hRS)
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Interligne
'//=========================================================
Public Sub SetInterlinesSpacing(iLgne As Integer)
On Error Goto HANDLE_ERROR
hStyle.InterLineSpacing=iLigne
Call hRTBody.AppendParagraphStyle(hStyle)
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub


'//=========================================================
'// Taille de la police
'//=========================================================
Public Sub SetFont(iFont As Integer)
On Error Goto HANDLE_ERROR
hRS.NotesFont=iFont
Call hRTBody.AppendStyle(hRS)
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub

'//=========================================================
'// Construit la liste de tous les destinataires
'//=========================================================
Private Function BuildRecipients(vContener As Variant, vRecipients As Variant)
On Error Goto HANDLE_ERROR
If m_Trace Then Call TraceMsg("Construction de la liste des destinataires")
Forall element In vRecipients
Call addElement(vContener,element)
If m_Trace Then
Call TraceMsg("Envoi du message à : " & element)
End If
End Forall
BuildRecipients=True
END_HANDLE_ERROR:
Exit Function
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Function

'//=========================================================
'// Définit la liste des destinataires
'//=========================================================
Private Function addElement(vContener As Variant, sRecipient As Variant)
On Error Goto HANDLE_ERROR
If Isempty(vContener) Then
Redim vContener(0)
Else
Redim Preserve vContener(Ubound(vContener)+1)
End If
vContener(Ubound(vContener))=sRecipient
addElement=True
END_HANDLE_ERROR:
Exit Function
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Function

'//=======================================================
'// Gestion des erreurs de runtime
'//=======================================================
Private Sub PrintError (iErr As Integer,sError As String, iErrLine As Integer, sProc As String)
m_iError=iErr
m_sError=sErr
m_iErrorLine=iErrLine
m_bError=True
m_sProc=sProc
m_sErrorMsg="Erreur n° " & iErr & " : " & sError & " - ligne " & iErrLine
' On prévoit le cas d'un fonctionnement sur serveur
If hSession.IsOnServer Then
Print m_sErrorMsg & " [MAIL_TO_MAILBOX]"
Else
Msgbox m_sErrorMsg,16,Lsi_info(2)
End If
End Sub

Private Sub TraceMsg (sMsg As String)
Print sMsg
End Sub

Private Sub statusMsg(sMsg As String)
If hSession.IsOnServer Then
Print sMsg;" [";Lsi_info(2);"]"
Else
Msgbox sMsg,16,Lsi_info(2)
End If
End Sub

Private Sub init(bAnonym As Boolean, bForceToServer As Boolean, sDefaultServer As String)
On Error Goto HANDLE_ERROR
'// Session et base active
Set hSession = New NotesSession
Set hCurrentDatabase = hSession.CurrentDatabase
'// Détection de la base courrier active de l'utilisateur connecté
Set hDbOpenMail =New NotesDatabase("","")
hDbOpenMail.OpenMail
'// Cependant on peut forcer l'accès à la mail.box sur le serveur de messagerie pour un
'// un accès anonyme
If bForceToServer Then
sMailServer=hCurrentDatabase.Server
'// Si la base est local on se repose sur le serveur de messagerie fourni par défaut
If sMailServer="" Then
sMailServer=sDefaultServer
End If
Else
sMailServer=hDbOpenMail.Server
End If
'// On trace le mode de création du courrier
Call TraceMsg("Initialisation en cours")
If bAnonym Then
hAnonyme=True
Call TraceMsg("Création d'un courrier anonyme")
Else
hAnonyme=False
Call TraceMsg("Création d'un courrier en mode normal")
End If
If sMailServer="" Then
Call TraceMsg("La mail.box est locale")
Else
Call TraceMsg("La mail.box est sur serveur")
End If

'// Envoi en mode anonyme
If bAnonym Then
Set hDbMailBox=New NotesDatabase(sMailServer,"mail.box")
If hDbMailBox.Server="" Then
Call TraceMsg("La mail.box est correctement ouverte en local")
Else
Call TraceMsg("La mail.box est correctement ouverte sur le serveur " & hDbMailBox.Server)
End If
Else
Set hDbMailBox=hCurrentDatabase
Call TraceMsg("Courrier créé temporairement dans " & hDbMailBox.Server)
End If
'// Initialisation du document courrier
Set hMailDoc=New NotesDocument(hDbMailBox)
Call hMailDoc.replaceItemValue("Form","Memo")
'// Initialisation du champ texte et de ses attributs
Set hRTBody = hMailDoc.CreateRichTextItem( "Body" )
Set hRS=hSession.CreateRichTextStyle
Set hStyle = hSession.CreateRichTextParagraphStyle
'// Options par défaut de distribution
hDeliveryReport="N"
hImportance="2"
hDeliveryPriority="N"
SMTPEncoding="0"
htmpSenderTag="N"
'// Mode Trace
If m_Trace Then
Call TraceMsg("Initialisation réussie")
End If
END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Call PrintError(Err,Error$,Erl,Lsi_info(2))
Resume END_HANDLE_ERROR
End Sub


End Class

[oguruma]

Exemple 1:

Use "MAIL_TO_MAILBOX"

Sub Initialize
'//============================================
'// Test d'envoi d'un message en mode anonyme
'//============================================
Dim hSession As NotesSession
Dim hDb As NotesDatabase
Dim hMail1 As Mail
Dim hMail2 As Mail
Dim vBody As Variant
Dim vSendTo As Variant
Dim vFiles As Variant

'//===============================
'// Initialisation de la session
'//===============================
On Error Goto HANDLE_ERROR
Set hSession=New NotesSession
Set hDb=hSession.CurrentDatabase


'//================================================================================
'// Initialise l'objet mail
'// @Paramètre 1 : envoi anonyme
'// @Paramètre 2 : on ne force la création dans la mailbox serveur (aucun sens en mode non anonyme
'// @Paramètre 3 : pas de serveur mail par défaut si l'application est locale
'//=================================================================================
Set hMail1=New Mail(True,False,"")

'//=================================================
'// Définition du sujet du message
'//================================================
hMail1.Subject="Message de test anonyme - Simple"

'//===============================
'// Gestion des émetteurs; destinataires
'//===============================

'// L'émetteur est anonyme
hMail1.FromBy="ROBOT APPLICATIF"
hMail1.Principal="FOXTROT"
'// On force le destinataire de la réponse
hMail1.ReplyTo="Admin SUPER"

'//==============================================================
'// Initialise les destinataires
'//==============================================================
Call hMail1.AddSendTo("Dev DESEIGNER")
Call hMail1.AddCopyTo("Admin DELTA")
Call hMail1.AddBlindCopyTo("Admin SUPER")

'//==============================================================
'// il est aussi possible de passer un tableau de destinataires
'//==============================================================
Redim vSendTo(1)
vSendTo(0)="Admin SUPER"
vSendTo(1)="Admin02 FOXTROT"
Call hMail1.AddSendTo(vSendTo)

'//==============================================================
'// Il existe bien entendu les méthode AddCopyTo et AddBlindCopyTo
'// Voir le code de la classe
'//==============================================================

'//===============================
'// On demande un AR
'//===============================
hMail1.ReturnReceipt=True

'//===========================================
'// Exemple de mise en forme du message
'//===========================================
hMail1.Bold=True
hMail1.Italic=True
hMail1.Color=COLOR_BLUE
hMail1.FontSize=12
hMail1.Fonte=FONT_COURIER
hMail1.InterlinesSpacing=SPACING_DOUBLE

'//==============================================================
'// On place le texte - True = saut ligne
'// - False = pas de passage à la ligne suivante après insertion
'//==============================================================
Call hMail1.SetBody("Bonjour",True)
Call hMail1.SetBody("Message de test, ne pas tenir compte",True)
Call hMail1.NewLine(2)

'//==============================================================
'// On peut également passer un tableau contenant le texte du message
'//==============================================================
Redim vBody(1)
vBody(0)="C'est un message de test. "
vBody(1)=" Test d'une classe de messagerie"


'//==============================================================
'// Passage du tableau et il n'y a pas de retour à la ligne
'//==============================================================
Call hMail1.SetBody(vBody,False)
Call hMail1.NewLine(2)

'//==============================================================
'// Et on peut de nouveau terminer avec une ligne simple en chaine de caractères
'//==============================================================
hMail1.Underline=True
hMail1.Alignment=ALIGN_CENTER
Call hMail1.SetBody("Administrateur Lotus Notes",True)

'//==========================================================
'// On y insère les pièces jointes avec réinitialisation de la mise en forme
'//==========================================================
hMail1.Alignment=ALIGN_LEFT
hMail1.Underline=False
hMail1.Bold=False
hMail1.Italic=False
hMail1.Fonte=FONT_ROMAN
hMail1.Color=COLOR_BLACK
hMail1.FontSize=10
Call hMail1.NewLine(2)

'//==============================================================
'// Et on insère des pièces jointes
'//==============================================================
Redim vFiles(1)
vFiles(0)="c:\_ip.bat"
vFiles(1)="c:\_ip.tmp"
Call hMail1.SetAttachedFiles(vFiles)

'//===============================
'// Et enfin quelques options d'émission
'//===============================
hMail1.DeliveryPriority="H"
hMail1.Importance="1"
hMail1.DeliveryReport="B"
hMail1.SMTPEncoding="0"
hMail1.SenderTag="G"
hMail1.Sign="1"
hMail1.ExpireDate=Cdat("25/12/2006")
hMail1.ReplyDate=Cdat("30/06/2006")

'//===============================
'// Envoi du message
'//===============================
Call hMail1.Send(False)


END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Msgbox "Erreur n° " & Err & " " & Error$ & " ligne " & Erl,16,"Test Message"
Resume END_HANDLE_ERROR
End Sub

[oguruma]

Exemple 2 :

Sub Initialize
'//============================================
'// Test d'envoi d'un message en mode non anonyme
'// message simple
'//============================================
Dim hSession As NotesSession
Dim hDb As NotesDatabase
Dim hMail1 As Mail
Dim vSendTo As Variant
Dim vBody As Variant
Dim vFiles As Variant

'//===============================
'// Initialisation de la session
'//===============================
On Error Goto HANDLE_ERROR
Set hSession=New NotesSession
Set hDb=hSession.CurrentDatabase

'//================================================================================
'// Initialise l'objet mail
'// @Paramètre 1 : envoi non anonyme
'// @Paramètre 2 : on ne force la création dans la mailbox serveur (aucun sens en mode non anonyme
'// @Paramètre 3 : pas de serveur mail par défaut si l'application est locale
'//=================================================================================
Set hMail1=New Mail(False,False,"")

'//===============================
'// Définition du sujet du message
'//===============================
hMail1.Subject="Message de test non anonyme - Message simple"

'//===============================
'// Gestion des émetteurs; destinataires
'//===============================

'// L'émetteur est identifiée mais on peut lui mettre un pseudo
hMail1.Principal="FOXTROT"

'// On force le destinataire de la réponse
hMail1.ReplyTo="Admin SUPER"

'//==============================================================
'// Initialise les destinataires
'//==============================================================
Call hMail1.AddSendTo("Dev DESEIGNER")
Call hMail1.AddCopyTo("Admin DELTA")
Call hMail1.AddBlindCopyTo("Admin SUPER")

'//==============================================================
'// il est aussi possible de passer un tableau de destinataires
'//==============================================================
Redim vSendTo(1)
vSendTo(0)="Admin SUPER"
vSendTo(1)="Admin02 FOXTROT"
Call hMail1.AddSendTo(vSendTo)

'//==============================================================
'// Il existe bien entendu les méthode AddCopyTo et AddBlindCopyTo
'// Voir le code de la classe
'//==============================================================

'//===============================
'// On demande un AR
'//===============================
hMail1.ReturnReceipt=True

'//===============================
'// Mise en forme du message
'//===============================
hMail1.Bold=True
hMail1.Italic=True
hMail1.Color=COLOR_BLUE
hMail1.FontSize=16

'//==============================================================
'// On place le texte - True = saut ligne
'// - False = pas de passage à la ligne suivante après insertion
'//==============================================================
Call hMail1.SetBody("Bonjour",True)
Call hMail1.SetBody("Message de test, ne pas tenir compte",True)
Call hMail1.NewLine(2)

'//==============================================================
'// On peut également passer un tableau contenant le texte du message
'//==============================================================
Redim vBody(1)
vBody(0)="C'est un message de test. "
vBody(1)=" Test d'une classe de messagerie"

'//==============================================================
'// Passage du table et il n'y a pas de retour à la ligne
'//==============================================================
Call hMail1.SetBody(vBody,False)
Call hMail1.NewLine(2)

'//==============================================================
'// Et on peut de nouveau terminer avec une ligne simple en chaine de caractères
'//==============================================================
Call hMail1.SetBody("Administrateur Lotus Notes",True)

'//==========================================================
'// On y insère les pièces jointes avec réinitialisation de la mise en forme
'//==========================================================
hMail1.Bold=False
hMail1.Italic=False
hMail1.Color=COLOR_BLACK
hMail1.FontSize=10

'//==============================================================
'// Et on insère des pièces jointes
'//==============================================================
Redim vFiles(1)
vFiles(0)="c:\_ip.bat"
vFiles(1)="c:\_ip.tmp"
Call hMail1.SetAttachedFiles(vFiles)

'//===============================
'// Envoi du message
'//===============================
Call hMail1.Send(False)


END_HANDLE_ERROR:
Exit Sub
HANDLE_ERROR:
Msgbox "Erreur n° " & Err & " " & Error$ & " ligne " & Erl,16,"Test Message"
Resume END_HANDLE_ERROR
End Sub

[oguruma]

Je n'ai posté que deux exemples...
La base en possède d'autres

[Sylvain-PEPIN]

Salut,

Merci Oruguma
Je vais regarder ça avec attention, car j'ai un paquet de bases avec un agent de réponse auto, et malgrés le soin que j'ai apporté à mon agent, y'a toujours une p'tite trace de ma signature, et selon les client de mail en face, les mecs réussissent à voir mon adresse et m'écrive en "direct" ...

@+
Sylvain

[oguruma]

un complément d'information pour la mise en exploitation de la base utilisant cette classe :
les messages sont déposés dans une mail.box soit en local soit sur serveur.
Ceci est effectué bien entendu selon les paramètres passés dans le constructeur, mais aussi une partie du constructeur repose sur la localisation de la base courrier de l'utilisateur, il est donc impératif d'avoir un document site correctement configuré et pointant sur un serveur de messagerie (local ou nom de serveur) et une base mail.
la localisation de la base indiquera si mail.box utilisée sera en local ou sur un serveur de mail ou serveur applicatif
documenter donc cela dans votre document de mise en production
sans, cette classe a déjà été mise en production... it run fine !