[Toutes versions] Corps de mail Lotus avec des parties en gras

[the_6L20]

Bonjour,

J'ai une base de donnée qui suite a un clique crée un mail dans LOTUS NOTES.

le corps du mail contient du texte saisie dans le code et des variables qui prennent la bonne valeur au moment de la création du mail.

par soucis de lisibilité je voudrais pouvoir mettre certains mots en gras (principalement les variable).

j'ai trouvé un moyen de mettre en majuscule Ucas$(variable).

mais je n'arrive pas a trouver un moyen de mettre en gras.

si besoin je peux fournir une portion du code.


Merci d'avance de votre aide.

[jpcheck]

Hello,

il me semble qu'il est possible de passer le contenu d'un corps de mail par plusieurs méthodes:
- en HTML (en utilisant le cas echeant la balises <b>)
- la recopie d'un contenu de cellule Excel (on aura mis en forme les mots/phrases souhaitées dès leur écriture)

les différents exemples disponibles dans la FAQ Access te donneront de bonnes pistes à suivre :
http://access.developpez.com/faq/ind...chercher=lotus

Bon courage

[the_6L20]

@jpcheck

merci pour l'idée,

mais j'arrive pas vraiment au résultat attendu:

code:

Code :

"Dossier Base N°  : " & HtmlEncode("<b>" & nN°dossier)

résultat dans lotus:

Dossier Base N° : &lt;b&gt;5

je ne peux pas passer par excel non plus les données sont issus de requetes SQL

[jpcheck]

un autre exemple de manipulation par HTML

Code :

[the_6L20]

bonjour,

j'ai pas mal triturer et essayer d'utiliser ce code, mais pas de résultat escompté.

j'ai systématiquement une erreur avec:

Code :

Set stream = s.CreateStream

en fait voici la fonction que j'utilise pour générer le mail:

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
Option Compare Database
 
'Envoi d'un mail avec Lotus Notes
'Subject : sujet du mail
'Attachment : nom d'une pièce jointe
'Recipient : adresse e-mail du destinataire principal
'ccRecipient : destinataire en copie
'bccRecipient : destinataire en copie invisible
'BodyText : corps du mail
'SaveIt : mettre à True pour que le mail soit sauvegardé
'Password : mot de passe
 
Public Sub SendNotesMail(ByVal Subject As String, ByVal Attachment As String, ByVal Recipient As String, ByVal Body As String)
 
    Dim Maildb As Object      'La base des mails
    Dim UserName As String    'Le nom d'utilisateur
    Dim MailDbName As String  'Le nom de la base des mails
    Dim MailDoc As Object     'Le mail
    Dim AttachME As Object    'L'objet pièce jointe en RTF
    Dim Session As Object     'La session Notes
    Dim EmbedObj As Object    'L'objet incorporé
 
    'Crée une session notes
    Set Session = CreateObject("Notes.NotesSession")
 
    '*** Cette ligne est réservée aux versions 5.x et supérieur : ***
    'Session.Initialize (Password)
 
    'Récupère le nom d'utilisateur et crée le nom de la base des mails
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
 
    'Ouvre la base des mails
    Set Maildb = Session.GETDATABASE("", MailDbName)
    If Not Maildb.ISOPEN Then Maildb.OPENMAIL
 
 
    'Paramètre le mail à envoyer
 
    Set MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"
    MailDoc.SendTo = Recipient
    MailDoc.CopyTo = ccRecipient
    MailDoc.BlindCopyTo = bccRecipient
    MailDoc.Subject = Subject
    MailDoc.Body = bodytext
    MailDoc.SAVEMESSAGEONSEND = SaveIt
 
 
     'Prend en compte les pièces jointes
        'Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        'Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        'MailDoc.CREATERICHTEXTITEM (Attachment)
 
 
 
'Affichage du mail dans Lotus Notes
   Set Workspace = CreateObject("Notes.NotesUIWorkspace")
   Call Workspace.EDITDOCUMENT(True, MailDoc).FIELDSETTEXT("Body", Body)
 
 
 
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
End Sub

et voici le code de ce qui est normalement mis en contenu du mail:

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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
Private Sub Mail_Click()
 
    Dim nNorigine As Integer
 
        nNorigine = Me.N°Origine
 
 
        Dim SQLinfoDossier As String
        Dim RSTinfoDossier As Recordset
 
            SQLinfoDossier = "SELECT Origine.N°Origine, References.Marque, References.Designation, Dossier.N°Dossier, Dossier.Article, Dossier.Taille, Dossier.Matricule, Dossier.Quantité, Dossier.Observation, Origine.Origine, Origine.DateR, Origine.[Ecrin KO], Origine.[Chemise KO], Origine.[Certificat KO], Origine.[Carte de garantie KO], Origine.Commentaires " _
                            & "FROM [References] INNER JOIN (Dossier INNER JOIN Origine ON Dossier.N°Dossier = Origine.N°Dossier) ON References.Reference = Dossier.Article " _
                            & "WHERE (((Origine.N°Origine)= " & nNorigine & " ));"
 
 
 
 
            Set RSTinfoDossier = CurrentDb.OpenRecordset(SQLinfoDossier, dbOpenDynaset)
 
 
 
    Dim mMarque As String
    Dim nN°dossier As Double
    Dim aArticle As String
    Dim dDesignation As String
    Dim tTaille As String
    Dim mMatricule As String
    Dim qQuantité As Integer
    Dim oObservation As String
    Dim oOrigine As String
    Dim dDateR As Date
    Dim eEcrin As Boolean
    Dim cChemise As Boolean
    Dim cCertificat As Boolean
    Dim cCarte As Boolean
    Dim cCommentaires As String
 
 
                RSTinfoDossier.MoveFirst
 
                    mMarque = RSTinfoDossier.Fields("Marque")
                    nN°dossier = RSTinfoDossier.Fields("N°Dossier")
                    aArticle = RSTinfoDossier.Fields("Article")
                    dDesignation = RSTinfoDossier.Fields("Designation")
                    tTaille = RSTinfoDossier.Fields("Taille")
                    mMatricule = RSTinfoDossier.Fields("Matricule")
                    qQuantité = RSTinfoDossier.Fields("Quantité")
 
                    If IsNull(RSTinfoDossier.Fields("Observation")) Then
                        oObservation = ""
                    Else
                        oObservation = RSTinfoDossier.Fields("Observation")
                    End If
 
                    oOrigine = RSTinfoDossier.Fields("Origine")
                    dDateR = RSTinfoDossier.Fields("DateR")
                    eEcrin = RSTinfoDossier.Fields("Ecrin KO")
                    cChemise = RSTinfoDossier.Fields("Chemise KO")
                    cCertificat = RSTinfoDossier.Fields("Certificat KO")
                    cCarte = RSTinfoDossier.Fields("Carte de garantie KO")
                    If IsNull(RSTinfoDossier.Fields("Commentaires")) Then
                        cCommentaires = ""
                    Else
                        cCommentaires = RSTinfoDossier.Fields("Commentaires")
                    End If
 
 
            Dim X As Integer
            Dim Y As Variant
 
                Dim SQLMouvementMagasin As String
                Dim RSTMouvementMagasin As Recordset
 
            SQLMouvementMagasin = "SELECT Origine.N°Origine, Magasin.Msortie, Magasin.Mentre, Magasin.DateMVT, Magasin.N°MVT, Magasin.Commentaire, SAV.[Date Ctrl], SAV.Commentaire, SAV.Devis " _
                                & "FROM (Origine INNER JOIN Magasin ON Origine.N°Origine = Magasin.N°Origine) LEFT JOIN SAV ON Magasin.N°enregistrement = SAV.N°enregistrement " _
                                & "WHERE (((Origine.N°Origine)=" & nNorigine & " ));"
 
 
 
            Set RSTMouvementMagasin = CurrentDb.OpenRecordset(SQLMouvementMagasin, dbOpenDynaset)
 
                RSTMouvementMagasin.MoveFirst
                    X = 0
                    Do While Not RSTMouvementMagasin.EOF
                        X = X + 1
                        RSTMouvementMagasin.MoveNext
 
                    Loop
 
 
                        ReDim mMsortie(0 To X) As String
                        ReDim mMentre(0 To X) As String
                        ReDim dDateMVT(0 To X) As Date
                        ReDim nNMvte(0 To X) As String
                        ReDim ccommentairem(0 To X) As String
                        ReDim dDateCtrl(0 To X) As String
                        ReDim csavCommentaire(0 To X) As String
                        ReDim dDevis(0 To X) As String
 
 
                            RSTMouvementMagasin.MoveFirst
                                Y = 0
 
                                Do While Not RSTMouvementMagasin.EOF
 
 
                                        If IsNull(RSTMouvementMagasin.Fields("Msortie")) Then
                                            mMsortie(Y) = ""
                                        Else
                                            mMsortie(Y) = RSTMouvementMagasin.Fields("Msortie")
                                        End If
 
 
                                        If IsNull(RSTMouvementMagasin.Fields("Mentre")) Then
                                            mMentre(Y) = ""
                                        Else
                                            mMentre(Y) = RSTMouvementMagasin.Fields("Mentre")
                                        End If
 
 
                                        If IsNull(RSTMouvementMagasin.Fields("DateMVT")) Then
                                            dDateMVT(Y) = ""
                                        Else
                                            dDateMVT(Y) = RSTMouvementMagasin.Fields("DateMVT")
                                        End If
 
 
                                        If IsNull(RSTMouvementMagasin.Fields("N°MVT")) Then
                                            nNMvte(Y) = ""
                                        Else
                                            nNMvte(Y) = RSTMouvementMagasin.Fields("N°MVT")
                                        End If
 
 
                                        If IsNull(RSTMouvementMagasin.Fields("magasin.Commentaire")) Then
                                            ccommentairem(Y) = ""
                                        Else
                                            ccommentairem(Y) = RSTMouvementMagasin.Fields("magasin.Commentaire")
                                        End If
 
 
                                        If IsNull(RSTMouvementMagasin.Fields("Date Ctrl")) Then
                                            dDateCtrl(Y) = ""
                                        Else
                                            dDateCtrl(Y) = RSTMouvementMagasin.Fields("Date Ctrl")
                                        End If
 
 
                                        If IsNull(RSTMouvementMagasin.Fields("sav.Commentaire")) Then
                                            csavCommentaire(Y) = ""
                                        Else
                                            csavCommentaire(Y) = RSTMouvementMagasin.Fields("sav.Commentaire")
                                        End If
 
 
                                        If IsNull(RSTMouvementMagasin.Fields("Devis")) Then
                                            dDevis(Y) = ""
                                        Else
                                          dDevis(Y) = RSTMouvementMagasin.Fields("Devis")
                                        End If
 
                                    Y = Y + 1
                                    RSTMouvementMagasin.MoveNext
 
                                Loop
 
 
                Dim Z As Integer
                Dim Histo As String
 
                    Z = 0
                    Histo = ""
 
                        Do While Not Z = X
                            Histo = Histo & " Mouvementé du : " & mMsortie(Z) & Chr(9) & " au : " & mMentre(Z) & Chr(9) & " Par le mouvement N° : " & nNMvte(Z) & Chr(9) & " Du : " & dDateMVT(Z) & Chr(10)
 
                                    If ccommentairem(Z) <> "" Then
                                        Histo = Histo & " Commentaire du mouvement : " & ccommentairem(Z) & Chr(10) & Chr(10)
                                    End If
 
                                If dDateCtrl(Z) <> "" Then
                                    Histo = Histo & Chr(10) & Chr(9) & Chr(9) & " Controlé SAV le: " & dDateCtrl(Z) & Chr(9) & " Commentaire : " & csavCommentaire(Z)
                                    If dDevis(Z) <> "" Then
                                        Histo = Histo & Chr(9) & " Montant du Devis : " & dDevis(Z) & Chr(10) & Chr(10)
                                    Else
                                        Histo = Histo & Chr(10) & Chr(10)
                                    End If
                                End If
 
                            Z = Z + 1
                        Loop
 
 
 
 
    Dim Subject As String
    Dim Attachement As String
    Dim Recipient As String
    Dim Body As String
 
        Attachement = ""
        Recipient = ""
        Subject = ""
 
 
 
 
 
 
        Body = "Nous avons mouvementé : " & Chr(10) & Chr(10) _
               & "Dossier Base N°  : " & "<b>" & (nN°dossier) & "</b>" & Chr(10) & " Type : " & mMarque & Chr(10) & " Article : " & aArticle & Chr(9) & " Désignation : " & dDesignation & Chr(10) & " Taille : " & tTaille & Chr(10) & " Quantité : " & qQuantité & Chr(10)
 
                    If mMatricule <> "" Then
                        Body = Body & " Matricule : " & mMatricule & Chr(10)
                    End If
 
                    If oObservation <> "" Then
                        Body = Body & Chr(10) & Chr(10) & " Observation : " & oObservation
                    End If
 
                Body = Body & " Origine : " & oOrigine & Chr(10) & " Date de reception : " & dDateR & Chr(10) _
                    & " Ecrin KO : " & eEcrin & Chr(10) & " Chemise KO : " & cChemise & Chr(10) & " Certificat Abscent : " & cCertificat & Chr(10) & " Carte de garantie Abscente : " & cCarte & Chr(10)
 
                    If cCommentaires <> "" Then
                        Body = Body & " Commentaire : " & cCommentaires
                    End If
                Body = Body & Chr(10) & Chr(10) & Histo & Chr(10) & Chr(10) & Chr(10) & Chr(10) & " Nous attendons vos instructions." & Chr(10) & Chr(10) & Chr(10) & m_stringsignature
 
 
                    SendNotesMail Subject, Attachement, Recipient, Body
End Sub

en sachant que pour le moment je n'ai essayer de mettre des balises qu'a un seul endroit puisque je suis toujours a la recherche de la solution:

Code :

1
2
        Body = "Nous avons mouvementé : " & Chr(10) & Chr(10) _
               & "Dossier Base N°  : " & "<b>" & (nN°dossier) & "<:b>"

[the_6L20]

j'ai en partie avancé

il fallait que je retire :

Code :

FIELDSETTEXT("Body", Body)

de

Code :

Call Workspace.EDITDOCUMENT(True, MailDoc).FIELDSETTEXT("Body", Body)

qui se situé sur la fin du code de la fonction mail.

en fait maintenant j'utilise ce code:

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
Option Compare Database
 
'Envoi d'un mail avec Lotus Notes
'Subject : sujet du mail
'Attachment : nom d'une pièce jointe
'Recipient : adresse e-mail du destinataire principal
'ccRecipient : destinataire en copie
'bccRecipient : destinataire en copie invisible
'BodyText : corps du mail
'SaveIt : mettre à True pour que le mail soit sauvegardé
'Password : mot de passe
 
Public Sub SendNotesMail(ByVal Subject As String, ByVal Attachment As String, ByVal Recipient As String, ByVal Body As String)
 
    Dim mailDB As Object      'La base des mails
    Dim UserName As String    'Le nom d'utilisateur
    Dim MailDbName As String  'Le nom de la base des mails
    Dim mailDoc As Object     'Le mail
    Dim AttachME As Object    'L'objet pièce jointe en RTF
    Dim Session As Object     'La session Notes
    Dim EmbedObj As Object    'L'objet incorporé
    Dim Style As Object
    Dim Contenu As Object
 
    'Crée une session notes
    Set Session = CreateObject("Notes.NotesSession")
 
    '*** Cette ligne est réservée aux versions 5.x et supérieur : ***
    'Session.Initialize (Password)
 
    'Récupère le nom d'utilisateur et crée le nom de la base des mails
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
 
    'Ouvre la base des mails
    Set mailDB = Session.GetDatabase("", MailDbName)
    If Not mailDB.IsOpen Then mailDB.OPENMAIL
 
 
  'Affichage du mail dans Lotus Notes
   Set workspace = CreateObject("Notes.NotesUIWorkspace")
 
   Set Style = Session.CreateRichTextStyle
 
    'Paramètre le mail à envoyer
 
    Set mailDoc = mailDB.CreateDocument
    mailDoc.Form = "Memo"
    mailDoc.SendTo = Recipient
    mailDoc.CopyTo = ccRecipient
    mailDoc.BlindCopyTo = bccRecipient
    mailDoc.Subject = Subject
    mailDoc.SAVEMESSAGEONSEND = SaveIt
 
 
    Set Contenu = mailDoc.CreateRichTextItem("Body")
 
Genere_body Body, Contenu, Style
 
     'Prend en compte les pièces jointes
        'Set AttachME = MailDoc.CreateRichTextItem("Attachment")
        'Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "Attachment")
        'MailDoc.CreateRichTextItem (attachement)
 
 
 
   Call workspace.EDITDOCUMENT(True, mailDoc)
 
 
 
 
    Set mailDB = Nothing
    Set mailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
End Sub
 
 
Private Sub Genere_body(Corps As String, Body As Object, Style As Object)
'Cette procédure pilote Lotus Notes pour adapter un texte formaté en HTML au format Notes
Dim Longueur_message As Long, a As Integer, b As Integer, Balise As String, Tbl_Style(2) As String, Taille As Byte
 
Tbl_Style(0) = "<b>": Tbl_Style(1) = "<i>": Tbl_Style(2) = "<u>"
Taille = UBound(Tbl_Style)
Longueur_message = Len(Corps)
 
With Body
 
   For a = 1 To Longueur_message
10      For b = 0 To Taille 'On regarde s'il y a une ouverture de balise
            If Mid(Corps, a, Len(Tbl_Style(b))) = Tbl_Style(b) Then
 
                Select Case Tbl_Style(b)
 
                Case "<b>" 'Gras
                    Style.Bold = True
                    Balise = "<b>"
                Case "<i>" 'Italique
                    Style.Italic = True
                    Balise = "<i>"
                Case "<u>" 'Souligné
                    Style.Underline = True
                    Balise = "<u>"
                End Select
                a = a + Len(Balise) 'On ne met pas la balise ouvrante dans le corps de texte
                'Dans l'hypothèse où des balises se suivent ou se ferment (Exemple : <b><i>Florent</i></b>), on fait un test sur les caractères suivants
                GoTo 10
            Else 'On traite les balises de fermeture
                Balise = Replace(Tbl_Style(b), "<", "</")
 
                If Mid(Corps, a, Len(Balise)) = Balise Then
 
                    Select Case Tbl_Style(b)
 
                    Case "<b>" 'Gras
                        Style.Bold = False
                    Case "<i>" 'Italique
                        Style.Italic = False
                    Case "<u>" 'Souligné
                        Style.Underline = False
                    End Select
                    a = a + Len(Balise) 'On ne met pas la balise fermante dans le corps de texte
                    GoTo 10
                End If
            End If
        Next b
        Balise = ""
        .AppendStyle Style
        .AppendText Mid(Corps, a, 1)
    Next a
    .Update
End With
End Sub

le souci que j'ai maintenant c'est que ma signature automatique dans lotus reste dans le mail et apparaît avant le texte qui s’insère.

comment puis je faire pour la faire disparaître, ou dans l’idéale, pour quelle se retrouve à la fin du texte.

d'avance merci pour votre aide.