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 : Sélectionner tout - Visualiser dans une fenêtre à part
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.
Envoie d'un mail classique.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
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).
Envoie d'un mail dont le corps est un fichier HTML (chemin d'accès au fichier à fournir en paramètre)
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Partager