[VBA] Envoi mail lotus notes en utilisant un modèle

Version imprimable

Bonjour,

Voila mon problème, j'ai trouvé sur le net un code me permettant d'envoyer un mail lotus notes via vba excel.

Je doit automatiser un envoie de mail via Lotus notes mais je dois laisse dans le corps du mail prédéfini dans un modele lotus.

Voici le code que j'ai trouve sur ce forum :

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
'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 ccRecipient As String, _
                         ByVal bccRecipient As String, ByVal BodyText As String, _
                         ByVal SaveIt As Boolean, ByVal Password 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
    If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
 
    'Envoie le mail
    MailDoc.PostedDate = Now()
    MailDoc.SEND 0, Recipient
 
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
End Sub

Je voulais donc savoir s'il etait possible d'ouvrir un modèle plutôt qu'un nouveau mémo dans l'automatisation de mail ou sinon s'il était possible par un quelconque moyen de décrire un tableau dans le corps du mail sous vba.

Merci d'avance

Cordialement

24/10/2008, 11h13
Godzestla

Fichtre,

j'ai déjà vu ce code quelquepart ;)

je ne sais pas faire ce que tu demandes, mais tu peux passer ton tableau en attachement (en utilisant la variable attachement du code).

Au-delà, aucuine idée. :cry:
24/10/2008, 11h25
Keelit95

Malheureusement pour moi,

Le tableau doit etre imperativement dans le corps du mail.
24/10/2008, 11h46
Godzestla

Essaie de manipuler l'object Maildoc.Body.

Si tu ne trouves pas, regarde du côté d'envoi des emails via Outlook. même si c'est différent, je suis certain qu'il est possible de pêcher des idées, tu type paste ou autres.

Bonjour,

j'essaie de suivre la piste du copier/coller mais en parallèle je voulais savoir si quelqu'un savais comment utiliser un signet lotus notes via vba ?

Voila ce que j'ai pu trouver pour outlook :

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
Private Sub Command1_Click()
Dim myolapp As Outlook.Application
Dim myitem As Outlook.MailItem
Dim str As String
Dim msn As VbMsgBoxResult
 
Set myolapp = CreateObject("Outlook.Application")
Set myitem = myolapp.CreateItem(olMailItem)
 
myitem.Subject = "Objet du mail"
Set myRecipients = myitem.Recipients
myRecipients.Add ("cnn@cnn.com")
 
str = "<body>"
str = str & "<p>Salut test mail</p>"
str = str & "<table border=1 width=100% bordercolor=#00FFFF>"
str = str & " <tr>"
str = str & " <td width= 50% bgcolor= #C0C0C0 >BLABLA </td>"
str = str & " <td width=50% bgcolor=#C0C0C0>&zzzzzzzz</td>"
str = str & " </tr>"
str = str & " <tr>"
str = str & " <td width=50%>STESTTSTST</td>"
str = str & " <td width=50%><font color=#000080>AAAAA</font></td> "
str = str & "</tr>"
str = str & "</table>"
str = str & "<P>" & Text1 & "</p>"
str = str & "</body></html>"
 
myitem.HTMLBody = str
 
myitem.Display
 
End Sub

j'ai essaye d'adapter cela pour notes, seulement la fonction "display" n'est pas reconnu.

Si jamais tu sais comment je pourrai adapter ca à notes.

Merci d'avance.

Cordialement

31/10/2008, 09h21
Keelit95

Bonjour à tous,

Voila ne trouvant pas de solution directe à mon probleme j'ai préféré une solution annexe.

J'ai donc décidé d'envoyer mon mail par outlook en me servant du "IBM connector" qui me permet d'envoye un mail de mon adresse Lotus notes via outlook.

Je peux donc code mon envoie de mail VBA via outlook en ayant en adresse apparente mon adresse Lotus notes.

Je peux decrire mon tableau en HTML.

Voila je sais pas si je peux mettre la motion resolu puisque ce n'est pas réellement une solution.

Bonne journée.

Cordialement

moi
03/11/2008, 09h20
Godzestla

Citation:

Envoyé par Keelit95

Bonjour à tous,

Voila je sais pas si je peux mettre la motion resolu puisque ce n'est pas réellement une solution.

Bonjour Keelit95,
dans ce cas tu peux aussi sélectionner délestage.

Bonne journée à toi aussi.
Moi.

bonjour,

je répond peut être trop tard ou à coté.

Peut tu envoyer ton tableau en image avec CopyPicture

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
'  ActiveWorkbook.Worksheets("NomFeuille").Activate
'on mémorise si le quadrillage est affiché
  DG = ActiveWindow.DisplayGridlines
'on enlève le quadrillage
  ActiveWindow.DisplayGridlines = False
 
Tableau = ActiveSheet.PageSetup.PrintArea
'Copie, en tant qu'image, les cellules sélectionnées dans la feuille.
  Range(Tableau ).CopyPicture
 
'on colle
  ActiveSheet.Paste
'on recopie dans le presse papier
  Selection.Copy
'on supprime l'image temporaire
  Selection.Delete
'on rétablie le quadrillage comme à l'origine
  ActiveWindow.DisplayGridlines = DG
Application.ScreenUpdating = True

ensuite ce n'est pas très propre mais

Code:

SendKeys "+{INSERT}", True

devrait fonctionner

cordialement

Cordialement

[EXCEL 2000 - LOTUS 6]

Je cherche moi aussi à envoyer un mail contenant un tableau de données.

Malheureusement ce tableau n'est pas une copie d'une table. Je voudrais le créer de tout pièce en HTML.

J'utilise le code suivant qui marche pour envoyer un mail classique: ça c'est bon.

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
 
 Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
 
    Set Maildb = Session.GETDATABASE("", MailDbName)
     If Maildb.IsOpen = True Then
     Else
         Maildb.OPENMAIL
     End If
    Set MailDoc = Maildb.CREATEDOCUMENT
 
 
    MailDoc.Form = "Memo"
    MailDoc.sendto = recip
    MailDoc.Subject = Subject
    MailDoc.Body = BodyText
 
 
    MailDoc.SAVEMESSAGEONSEND = SaveIt
    If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
    MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
    MailDoc.SEND 0, recip
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing

J'ai essayé de modifier en ajoutant:

Code:

1
2
 
MailDoc.HTMLBody = "<HTML><H2>The body of this message will appear in HTML.</H2><BODY>Type the message text here. </BODY></HTML>"

et aussi:

Code:

1
2
3
4
 
    MailDoc.BodyFormat = olHTML
 ou
    MailDoc.BodyFormat = olFormatHTML

Mais le mail est vide (du moins il y à des saut de ligne et c'est tout !!!

Que faire ?

Merci

C'est bon..oufff

Bon alors.... après pas mal de temps sur Google et pas mal d'essais.....
Il n'y a rien sur la toile.....

M'enfin...j'ai trouvé un truc qui à l'air de marcher.

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
 
Public Function send_all_mail()
Dim retour As String
retour = MsgBox("Envoyer tous les élements(anomalies) en attente au QA ?", vbYesNo + vbQuestion + vbDefaultButton2, "Envoie groupé de Mail")
If retour = vbYes Then
    Dim message As String
    Dim sujet As String
    Dim i As Long
    i = 1
    connection
    Const notesclass$ = "NOTES"
    Dim Lotus_Session As Object
    Dim rc&
    Dim lotusWindow&
    lotusWindow = FindWindow(notesclass, vbNullString)
    If lotusWindow <> 0 Then
        Dim oRst2 As DAO.Recordset
        Set oRst2 = oDb.OpenRecordset("SELECT * FROM TParametres WHERE  ligne=1", dbOpenDynaset)
        If Not oRst2.Fields("Mail_1").Value = vbNullString Then
            recip(0) = oRst2.Fields("Mail_1").Value
            If Not oRst2.Fields("Mail_2").Value = vbNullString Then recip(1) = oRst2.Fields("Mail_2").Value
            If Not oRst2.Fields("Mail_3").Value = vbNullString Then recip(2) = oRst2.Fields("Mail_3").Value
            If Not oRst2.Fields("Mail_4").Value = vbNullString Then recip(3) = oRst2.Fields("Mail_4").Value
        Else
            MsgBox "Le Mail du QA n'est pas renseigné !!! (Voir dans la rubrique configuration !)" & Chr(13) & Chr(13) & "Le mail n'est pas envoyé !"
            check_dommageNC = False
            oDb.Execute "UPDATE TMLI  SET Mail_NC = '0' WHERE ID =" & Trim(ligne_selectionnee)
            Exit Function
        End If
        Set oRst = oDb.OpenRecordset("SELECT * FROM TMLI WHERE Mail_NC ='0' AND Endommagee_NC ='1'", dbOpenDynaset)
        '***********CREATION DU MESSAGE***********
message = vbNullString & "Message auto provenant de la MLI LIST<BR>Les éléments suivant ont été constatés endommagés:<BR> Numéro de la NC Rateau: " & oRst2.Fields("Numero_NC").Value
message = message & "<BR><BR><TABLE BORDER='0'>" _
& "<TR ALIGN='center'>" _
& "<TH> Elements </TH>" _
& "<TH> Réference </TH>" _
& "<TH> N° Série </TH>" _
& "<TH> Repère Topo </TH>" _
& "<TH> Localisation </TH>" _
& "<TH> Détail </TH>" _
& "<TH> Désignation </TH>" _
& "<TH> Remarque </TH>" _
& "</TR>"
 
    While Not oRst.EOF
        message = message & "<TR ALIGN='center'>" _
        & "<TH>" & i & "</TH>" _
        & "<TH>" & oRst.Fields("Reference").Value & "</TH>" _
        & "<TD>" & oRst.Fields("Numero_serie").Value & "</TD>" _
        & "<TD>" & oRst.Fields("rep_topo").Value & "</TD>" _
        & "<TD>" & oRst.Fields("localisation").Value & "</TD>" _
        & "<TD>" & oRst.Fields("loca_detail").Value & "</TD>" _
        & "<TD>" & oRst.Fields("designation").Value & "</TD>" _
        & "<TD>" & oRst.Fields("Remarq_Probleme").Value & "</TD></TR>"
        i = i + 1
        oRst.MoveNext
    Wend
message = message & "</TABLE><BR>"
 
        '***********ENVOIE DU MAIL GROUPE***********
        sujet = "GROUPE de MLI(s) à Inspecter/Réparer sur " & oRst2.Fields("Programme").Value
        SendNotesMail sujet, "", message, True
        oDb.Execute "UPDATE TMLI  SET Mail_NC = '1' WHERE Mail_NC ='0' AND Endommagee_NC ='1'"
        Set oRst2 = Nothing
        MsgBox "Mail envoyé avec succés et base de données mise à jour"
        alarme
        Exit Function
    Else
        MsgBox "Ouvrir une session Lotus et recommencer" & Chr(13) & Chr(13) & "Le mail n'est pas envoyé - La base n'est pas modifiée"
    End If
End If
End Function

et la deuxieme partie

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
 
Public Function SendNotesMail(Subject As String, Attachment As String, BodyText As String, SaveIt As Boolean)
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim maildoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    Set session = CreateObject("Notes.NotesSession")
    UserName = session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    Set Maildb = session.GETDATABASE("", MailDbName)
     If Maildb.IsOpen = True Then
     Else
         Maildb.OPENMAIL
     End If
    Set maildoc = Maildb.CreateDocument
 
Dim oStream As Object
Set oStream = session.CreateStream()
Call oStream.WriteText(BodyText)
'The Body MIME type
Set oBodyMime = maildoc.CreateMIMEEntity()
Call oBodyMime.SetContentFromText(oStream, "text/html;charset=iso-8859-1", False)
 
    maildoc.Form = "Memo"
    maildoc.SendTo = recip
    maildoc.Subject = Subject
    maildoc.SAVEMESSAGEONSEND = SaveIt
    'Set up the embedded object and attachment and attach it
    If Attachment <> "" Then
        Set AttachME = maildoc.CreateRichTextItem("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        maildoc.CreateRichTextItem ("Attachment")
    End If
    'Send the document
    maildoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
    maildoc.Send 0, recip
    'Clean Up
    Set Maildb = Nothing
    Set maildoc = Nothing
    Set AttachME = Nothing
    Set session = Nothing
    Set EmbedObj = Nothing
End Function

A adapter bien sur....:lol:
Voila.. je suis certain que cela va plaire à certains !!!!

:ccool:

26/01/2010, 18h59
ubellro

Utilisation d'un modèle à la place du défaut «Mémo»

Essai en ajoutant également le nom de ton modèle à l'aide de la variable:

MailStationeryName="Nom du modèle"