Envoi mail à un groupe de personne avec lotus

**mariol** · 28/03/2009, 20h56

Bonjour, je voudrais envoyer un mail à plusieur personne dont les adresses de courriel sont dans une table.
J'ai trouvée le code suivant qui fonctionne bien:

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
'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é
 
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)
 
    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")
 
    '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

Ensuite dans mon formulaire j'ai placé le code suivant avec un bouton:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
Private Sub Envoi_Click()
 
 
Call SendNotesMail(Forms!mail![champs_Objet], "", "test@hotmail.com", "", "", Forms!mail![message], True)
MsgBox "Message envoyé"
 
DoCmd.Close acForm, "mail"
 
 
End Sub

Je voudrais remplacer l'adresse "test@hotmail.com", par une table d'adresse. La table "adresse" et le champs "courriel"
Merci à l'avance pour l'aide

**User** · 28/03/2009, 22h11

Salut,

tu peux utiliser DAO pour parcourir ta table et mettre les adresses de ta table séparé par des ";" dans une variable:

tu peux t'inspirer ce ce lien et adapter l'exemple OutLook à Lotus:
http://access.developpez.com/sources...lookNewsLetter

A+

**mariol** · 30/03/2009, 16h55

J'ai réussi à mettre les adresses dans une table, mais quand j'envoie le message, seulement la première personne recois le message.

En regardant la message un peux partout dans le forum, je crois que pour lotus, les adresses doivent être dans une variable de type "variant" mais je ne sais pas comment faire après plusieurs tentative.
Merci pour votre aide.

Voici le code de mon module:

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
'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é
 
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)
 
    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")
 
    '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

Voici le code du bouton de mon formulaire:

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
Private Sub Envoi_Click()
 
Dim adresse As String
Dim oRst As DAO.Recordset
Dim oFld As DAO.Field
Dim strTo As String
Set oRst = CurrentDb.OpenRecordset("SELECT * FROM adresse")
'Boucle sur chaque client et les ajoute au champ BCC du mail
While Not oRst.EOF
  strTo = strTo & oRst.Fields("courriel") & ", "
  oRst.MoveNext
Wend
'Supprime la dernière virgule
adresse = Left(strTo, Len(strTo) - 2)
 
 
Call SendNotesMail(Forms!test![champs_Objet], "", adresse, "", "", Forms!test![message], True)
 
 
MsgBox "Message envoyé"
 
DoCmd.Close acForm, "test"
 
 
End Sub

**Lou Pitchoun** · 31/03/2009, 12h25

Salut,

Bizarre en effet.

Par contre, je crois avoir trouvé une piste : http://www.developpez.net/forums/d24...ess-via-lotus/

Il est écrit dans le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    MailDoc.Send 0, "toto@toto.fr"
    MailDoc.Send 1, "titi@toto.fr"
    MailDoc.Send 2, "tata@toto.fr"

Il suffirait donc d'écrire dans la fonction d'envoi de mail

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For i = 0 to Ubound(vAdresses)
    MailDoc.Send i, vAdresses(i)
Next

Ce qui impliquerai de passer en paramètre non pas une chaine mais un tableau qu'il faudrait dimensionner en fonction de tes destinataires

Ex :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Dim sAdresses() As String
Dim i As Integer
i = 0
While Not oRst.EOF
  ReDim Preserve sAdresses(i)
  sAdresses(i)= oRst.Fields("courriel")
  oRst.MoveNext
  i = i + 1
Wend

**mariol** · 31/03/2009, 21h53

Bonjour, je ne suis pas programmeur et votre aide m'est très précieuse, j'ai modifier mon code et le voici:

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
'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é
 
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)
 
    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")
 
    '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()
 
    For i = 0 To UBound(Recipient)
    MailDoc.Send i, Recipient(i)
    Next
    'MailDoc.Send 0, Recipient
 
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
 
End Sub

Si je ne change pas mon type de variable de Recipient pour "variant", j'ai un message d'erreur pour incompatibilité de type.
Si je définie la variable en type variant, le message est envoyer mais il y a un message d'erreur à l'ouverture du mail dans Lotus notes qui est "un masque enregistré ne doit pas contenir de sous-masques calculer"

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
Private Sub Envoi_Click()
 
Dim oRst As DAO.Recordset
Dim oFld As DAO.Field
Dim strTo As Variant
Set oRst = CurrentDb.OpenRecordset("SELECT * FROM adresse")
 
Dim sAdresses() As String
Dim i As Integer
i = 0
While Not oRst.EOF
  ReDim Preserve sAdresses(i)
  sAdresses(i) = oRst.Fields("courriel")
  oRst.MoveNext
  i = i + 1
Wend
 
 
 
Call SendNotesMail(Forms!test![champs_Objet], "", sAdresses, "", "", Forms!test![message], True)
 
 
 
MsgBox "Message envoyé"
 
DoCmd.Close acForm, "test"
 
 
End Sub

**mariol** · 11/04/2009, 20h14

Bonjour, j'ai trouvé la solution à mon message "un masque enregistré ne doit pas contenir de sous-masques calculer" dans lotus.
J'ai modifier le code en enlevant la ligne en rouge et cela fonctionne maintenant.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
    '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

Merci pour votre aide.

Envoi mail à un groupe de personne avec lotus

VBA Access

Discussions similaires

Partager

Partager