[Sources] Comment envoyer un e-mail via Lotus Notes ?

Comment envoyer un e-mail via Lotus Notes ?

Ce code est à copier dans un module et sert à simplifier l'envoi de mail par Lotus Notes d'après un certain nombre de paramètres.

Dans le cas d'un envoi classique, le corps du texte est un tableau de String initialisé par la procédure CreateLine.
Dans le cas d'un envoi par HTML, le fichier HTML doit être créé au préalable.

Ce code a été créé sur Access 2000 et est utilisé actuellement sur Access 2003.

Constantes utilisées

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Global Const FORMAT_PASSLIGNE As Integer = 1
Global Const FORMAT_COULEUR As Integer = 2
Global Const FORMAT_GRAS As Integer = 3
Global Const FORMAT_SOULIGNE As Integer = 4
Global Const FORMAT_TAILLE As Integer = 5
Global Const FORMAT_IDENT As Integer = 6
Global Const FORMAT_TEXT As Integer = 7
Public Const LOTUS_COLOR_BLACK As Integer = 0
Public Const LOTUS_COLOR_BLUE  As Integer = 4
Public Const LOTUS_COLOR_CYAN  As Integer = 7
Public Const LOTUS_COLOR_DARK_BLUE  As Integer = 10
Public Const LOTUS_COLOR_DARK_CYAN  As Integer = 13
Public Const LOTUS_COLOR_DARK_GREEN As Integer = 9
Public Const LOTUS_COLOR_DARK_MAGENTA  As Integer = 11
Public Const LOTUS_COLOR_DARK_RED  As Integer = 8
Public Const LOTUS_COLOR_DARK_YELLOW  As Integer = 12
Public Const LOTUS_COLOR_GRAY  As Integer = 14
Public Const LOTUS_COLOR_GREEN  As Integer = 3
Public Const LOTUS_COLOR_LIGHT_GRAY  As Integer = 15
Public Const LOTUS_COLOR_MAGENTA  As Integer = 5
Public Const LOTUS_COLOR_RED  As Integer = 2
Public Const LOTUS_COLOR_WHITE  As Integer = 1
Public Const LOTUS_COLOR_YELLOW  As Integer = 6
Public Const LOTUS_COLOR_ORANGE  As Integer = 114
Public Const LOTUS_COLOR_STYLE_NO_CHANGE  As Integer = 255

Création du tableau de String qui sera le corps du message.
Une ligne du tableau ne correspond pas à un saut de ligne dans le mail. Une ligne dans le tableau regroupe des caractères (mots, phrases) formattés de la même façon (soulignés, gras, couleurs).
Lors de l'appel de la fonction, il faut lui fournir le tableau de String (ByRef), la ligne du tableau à modifier, le nombre desaut de ligne à effectuer (0 pour rester sur la même ligne), la couleur (voir constantes), si il faut mettre en gras ou souligner, la taille de caractères, une identation et enfin, le texte à afficher.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Compare Database
Option Explicit
' Défini une nouvelle "ligne" formattée dans le tableau
' Une ligne n'est pas un spécialement une nouvelle ligne dans l'e-Mail
' Une ligne dans le tableau correspond à un ensemble de caractères formattés de la même façon
Public Sub CreateLine(ByRef Tableau() As String, num As Integer, passligne As Integer, _
 couleur As Integer, gras As Boolean, souligne As Boolean, taille As Integer, ident As Integer, texte As String)
 
 Tableau(num, FORMAT_PASSLIGNE) = CStr(passligne)
 Tableau(num, FORMAT_COULEUR) = CStr(couleur)
 Tableau(num, FORMAT_GRAS) = CStr(gras)
 Tableau(num, FORMAT_SOULIGNE) = CStr(souligne)
 Tableau(num, FORMAT_TAILLE) = CStr(taille)
 Tableau(num, FORMAT_IDENT) = CStr(ident)
 Tableau(num, FORMAT_TEXT) = texte
End Sub

Envoie d'un mail classique.
Paramètres :
SaveIt : Pour le sauver dans les Sent.
SendNow : Pour envoyer le mail directement.
OpenEdit : Pour ouvrir le mail dans Lotus Notes (modifications et annulation encore possibles).
SendFrom : Pour donner le nom d'une autre DB que celle de la boîte perso de l'utilisateur (pour envoyer d'une boîte partagée par exemple).
SendFromPersoIfFailure : Si le nom d'une autre DB est invalide, permet de générer une erreur (False) ou d'envoyer via la boîte perso (True).

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
''''''''''''''''''''''''''''''''''''''''''''''
' Envoie un mail suivant certains paramètres '
''''''''''''''''''''''''''''''''''''''''''''''
Public Sub SendNotesMail(Subject As String, Attachment As String, BodyText() As String, _
 SendTo As String, Optional CC As String = "", Optional BCC As String = "", _
 Optional SaveIt As Boolean = False, Optional SendNow As Boolean = False, Optional OpenEdit As Boolean = True, _
 Optional SendFrom As String, Optional SendFromPersoIfFailure As Boolean = False)
 
 Dim Maildb As Object           ' Database Lotus Notes
 Dim UserName As String         ' Nom de l'utilisateur Lotus Notes
 Dim MailDbName As String       ' Nom de la database
 Dim MailDoc As Object          ' Corps du mail
 Dim intAttach As Integer       ' Indice pour passer en revue le tableau de pièces jointes
 Dim Session As Object          ' Session Lotus Notes
 Dim EmbedObj As Object         ' Pièce jointe
 Dim Server As String           ' Nom du serveur
 Dim ric As Object              ' RichText (formattage du texte)
 Dim richStyle As Object        ' Style pour RichText
 Dim aryAttachment() As String  ' Tableau de pièces jointes
 Dim recip() As String          ' Tableau des destinataires
 Dim copie() As String          ' Tableau des personnes en copie
 Dim ws As Object               ' WorkSpace pour ouverture du document
 
On Error GoTo LotusNotesFail
 
 ' Initialisation de l'objet Session
 Set Session = CreateObject("Notes.NotesSession")
 ' Récupération du nom du serveur
 Server = Session.GetEnvironmentString("MailServer", True)
 ' Si le un nom de database (pour envoyer d'un boîte mail commune) est défini, on l'utilise.
 ' Sinon on utilise la boîte perso
 If SendFrom = vbNullString Then
  MailDbName = Session.GetEnvironmentString("MailFile", True)
 Else
  MailDbName = SendFrom
 End If
 ' Récupération du nom d'utilisateur Lotus Notes
 UserName = Session.UserName
 
 ' RicheText pour le formattage du mail
 Set richStyle = Session.CreateRichTextStyle
 
' Retour après erreur sur le nom de la database
BackFromWrongMailFile:
 
 ' Ouverture de la database
 Set Maildb = Session.GetDatabase(Server, MailDbName)
 ' Initialisation du document (mail en lui-même)
 Set MailDoc = Maildb.CreateDocument
 
' Lors de la création du document (sur .Form = "Memo" exactement),
' une erreur va être générée si le MailDbName fourni en paramètre est invalide.
' Cette erreur doit être récupérée pour le cas où le paramètre SendFromPersoIfFailure serait True,
' auquel cas il faudrait réessayer d'envoyer depuis la boîte perso.
On Error GoTo WrongMailFile
 
 ' Création du document
 With MailDoc
  .Form = "Memo"
  ' Les adresses mails sont entrées dans un tableau
  If Not SentTo = vbNullString Then
   recip = Split(Trim(SendTo), ",")
  End If
  If Not CC = vbNullString Then
   copie = Split(Trim(CC), ",")
  End If
  .SendTo = recip
  .CopyTo = copie
  .BlindCopyTo = BCC
  .Subject = Subject
  .SAVEMESSAGEONSEND = SaveIt
  ' Formattage du texte
  Set ric = .CreateRichTextItem("Body")
  ' Ajout de toute les lignes du tableau de chaînes de caractères
  For i = 1 To UBound(BodyText)
   If IsNumeric(BodyText(i, FORMAT_PASSLIGNE)) Then
    Call ric.AddNewLine(CInt(BodyText(i, FORMAT_PASSLIGNE)))
   End If
   If IsNumeric(BodyText(i, FORMAT_COULEUR)) Then
    richStyle.NotesColor = CInt(BodyText(i, FORMAT_COULEUR))
   End If
   richStyle.Bold = StringToBool(BodyText(i, FORMAT_GRAS))
   richStyle.Underline = StringToBool(BodyText(i, FORMAT_SOULIGNE))
   If IsNumeric(BodyText(i, FORMAT_TAILLE)) Then
    richStyle.FontSize = CInt(BodyText(i, FORMAT_TAILLE))
   End If
   If IsNumeric(BodyText(i, FORMAT_IDENT)) Then
    For j = 0 To BodyText(i, FORMAT_IDENT) - 1
     ric.AppendText Chr(9)
    Next
   End If
   Call ric.AppendStyle(richStyle)
   ric.AppendText BodyText(i, FORMAT_TEXT)
  Next
  ' Création des pièces jointes
  aryAttachment = Split(Attachment, "|")
  ' Ajout des pièces jointes
  For intAttach = LBound(aryAttachment) To UBound(aryAttachment)
   Set EmbedObj = ric.EmbedObject(1454, "", aryAttachment(intAttach), "Attach")
  Next intAttach
  ' Sauvegarde
  .Save False, False
  ' Sauvegarde dans les Sent de l'utilsateur
  .SAVEMESSAGEONSEND = SaveIt
  ' Envoie direct de l'e-Mail
  If SendNow Then
   .PostedDate = Now()
   .SEND False
  End If
 End With
 
 DoEvents
 
 ' Ouverture du document dans Lotus Notes
 If OpenEdit Then
  Set ws = CreateObject("notes.notesuiworkspace")
  DoEvents
  ws.OpenDatabase Server, MailDbName
  ws.EDITDOCUMENT True, MailDoc
 End If
 
 ' Libération des ressources
 Set Maildb = Nothing
 Set MailDoc = Nothing
 Set ric = Nothing
 Set ws = Nothing
 Set Session = Nothing
 Set EmbedObj = Nothing
 
Exit Sub
 
' Gestion des erreur
LotusNotesFail:
 Call Err.Raise(5001, "SendNotesMail", "Impossible to log into Lotus Notes")
Exit Sub
 
' Si le nom de la database en paramètre est invalide, on arrive ici
WrongMailFile:
 ' Si on veut utiliser la boîte perso comme backup
 If SendFromPersoIfFailure Then
  ' Si une erreur se produit ici, renvoie vers la gestion d'erreurs "générales"
  On Error GoTo LotusNotesFail
  ' Si le nom de la database est déjà celui de la boîte perso de l'utilisateur,
  ' cela veut dire que le paramètre était déjà celui-là, ou bien qu'on est déjà passé ici.
  ' Dans un cas comme dans l'autre, il faut renvoyer vers la gestion d'erreurs "générales"
  ' (sinon risque de "boucle infinie")
  If MailDbName = Session.GetEnvironmentString("MailFile", True) Then
   GoTo LotusNotesFail
  ' Sinon, on remplace le nom de la database fourni en paramètre par celui de la boîte perso de l'utilisateur
  Else
   MailDbName = Session.GetEnvironmentString("MailFile", True)
   ' Retour à la réouverture de la database pour une nouvelle tentative
   GoTo BackFromWrongMailFile
  End If
 ' Si on ne veut pas utiliser la boîte perso comme backup, génération d'une erreur
 Else
  GoTo LotusNotesFail
 End If
 
End Sub

Envoie d'un mail dont le corps est un fichier HTML (chemin d'accès au fichier à fournir en paramètre)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
'''''''''''''''''''''''''''''''''''''''''''''
' Envoie un mail à partir d'un fichier HTML '
'''''''''''''''''''''''''''''''''''''''''''''
Public Sub SendNotesMailHTML(Subject As String, fichierHTML As String, _
 SendTo As String, Optional CC As String = "", Optional BCC As String = "", _
 Optional SaveIt As Boolean = False, Optional SendNow As Boolean = False, Optional OpenEdit As Boolean = True, _
 Optional SendFrom As String, Optional SendFromPersoIfFailure As Boolean = False)
 
 Dim Maildb As Object       ' Database Lotus Notes
 Dim UserName As String     ' Nom de l'utilisateur Lotus Notes
 Dim MailDbName As String   ' Nom de la database
 Dim Session As Object      ' Session Lotus Notes
 Dim Server As String       ' Nom du serveur
 Dim MyDoc As Object        ' Corps du mail
 Dim ws As Object           ' WorkSpace pour ouverture du document
 
On Error GoTo LotusNotesFail
 
 ' Initialisation de l'objet Session
 Set Session = CreateObject("Notes.NotesSession")
 ' Récupération du nom du serveur
 Server = Session.GetEnvironmentString("MailServer", True)
 ' Si le un nom de database (pour envoyer d'un boîte mail commune) est défini, on l'utilise.
 ' Sinon on utilise la boîte perso
 If SendFrom = vbNullString Then
  MailDbName = Session.GetEnvironmentString("MailFile", True)
 Else
  MailDbName = SendFrom
 End If
 ' Récupération du nom d'utilisateur Lotus Notes
 UserName = Session.UserName
 
 Set ws = CreateObject("notes.notesuiworkspace")
 
' /****************************************************************************************************/ '
'  Cette partie du code ne sert qu'à vérifie que le nom de la database fourni en paramètre est correct   '
 
 
' Retour après erreur sur le nom de la database
BackFromWrongMailFile:
 
 ' Ouverture de la database
 Set Maildb = Session.GetDatabase(Server, MailDbName)
 ' Initialisation du document (mail en lui-même)
 Set MyDoc = Maildb.CreateDocument
 
On Error GoTo WrongMailFile
' Lors de la création du document (sur .Form = "Memo" exactement),
' une erreur va être générée si le MailDbName fourni en paramètre est invalide.
' Cette erreur doit être récupérée pour le cas où le paramètre SendFromPersoIfFailure serait True,
' auquel cas il faudrait réessayer d'envoyer depuis la boîte perso.
 ' Création du document
 With MyDoc
  .Form = "Memo"
 End With
 
' /****************************************************************************************************/ '
 
 
On Error GoTo WrongMailFile
 
    Set MyDoc = ws.COMPOSEDOCUMENT(Server, MailDbName, "Memo", 1, 1)
 
    On Error GoTo LotusNotesFail
 
    ' Initialisation du mail
    Call MyDoc.GOTOFIELD("Subject")
    Call MyDoc.InsertText(Subject)
    Call MyDoc.GOTOFIELD("EnterSendTo")
    Call MyDoc.InsertText(SendTo)
    Call MyDoc.GOTOFIELD("EnterCopyTo")
    Call MyDoc.InsertText(CC)
    Call MyDoc.GOTOFIELD("EnterBlindCopyTo")
    Call MyDoc.InsertText(BCC)
    Call MyDoc.GOTOFIELD("Body")
    Call MyDoc.IMPORT("html", fichierHTML)
    ' Sauvegarde si demandé dans les paramètres
    If SaveIt Then
     Call MyDoc.Save
    End If
    ' Envoie du mail si demandé dans les paramètres
    If SendNow Then
     Call MyDoc.SEND
     Call MyDoc.Close
    End If
    ' Ouverture en édition si demandé dans les paramètres
    If Not OpenEdit Then
     Call MyDoc.Close
    End If
    ' Libération des ressources
    Set Maildb = Nothing
    Set ws = Nothing
    Set Session = Nothing
 
Exit Sub
 
 
' Gestion des erreur
LotusNotesFail:
 Call Err.Raise(5001, "SendNotesMailHTML", "Impossible to log into Lotus Notes")
Exit Sub
 
' Si le nom de la database en paramètre est invalide, on arrive ici
WrongMailFile:
 ' Si on veut utiliser la boîte perso comme backup
 If SendFromPersoIfFailure Then
  ' Si une erreur se produit ici, renvoie vers la gestion d'erreurs "générales"
  On Error GoTo LotusNotesFail
  ' Si le nom de la database est déjà celui de la boîte perso de l'utilisateur,
  ' cela veut dire que le paramètre était déjà celui-là, ou bien qu'on est déjà passé ici.
  ' Dans un cas comme dans l'autre, il faut renvoyer vers la gestion d'erreurs "générales"
  ' (sinon risque de "boucle infinie")
  If MailDbName = Session.GetEnvironmentString("MailFile", True) Then
   GoTo LotusNotesFail
  ' Sinon, on remplace le nom de la database fourni en paramètre par celui de la boîte perso de l'utilisateur
  Else
   MailDbName = Session.GetEnvironmentString("MailFile", True)
   ' Retour à la réouverture de la database pour une nouvelle tentative
   GoTo BackFromWrongMailFile
  End If
 ' Si on ne veut pas utiliser la boîte perso comme backup, génération d'une erreur
 Else
  GoTo LotusNotesFail
 End If
 
End Sub