Discussion :

[Sam44310]

Bonjour,

Novice sur Access j'ai chercher sur internet sans succès, puis parmis le forum, si la question avait déjà été posée. Je n'ai certainement pas utilisé les bons termes.

Voilà je cherche depuis plusieurs jours si il est possible d'envoyer un mail regroupant les personnes présentes dans l'état.

Exemple j'ai créé ma requete qui regroupe toutes les associations, de cette requête j'ai fait un état.
dans cet état il y a tous les champs concernant les coordonnées des associations (mails, adresse, tel ...)

J'ai déjà ajouté les boutons de commande concernant l'exportation de cette liste en fichier PDF, en impression directe ainsi que l'exportation excel (avec le lien de la requête) CF photo

Je souhaiterai si celà est réalisable un bouton commande qui ouvrirai outlook avec toutes les adresses mails des associations de mon état afin d'envoyer un mail général tout comme calà fonctionne déjà en cliquant sur l'adresse mail d'une association. En quelque sorte une liste de dffusion.

Quelqu'un a t'il la réponse ? Ou pourriez vous me rediriger dans la bonne rubrique svp.

Merci d'avance.

[EricDgn]

Bonjour,

Ci-dessous, un exemple de codes pour envoyer un même message à toutes les adresses mail contenue dans le champ 'AdrMail' de la requête 'qTemp' selon que la messagerie est Outlook ou est une autre messagerie:

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
Private Sub EmailViaOutlook()
   Dim db As DAO.Database, rs As DAO.Recordset, objMessage As Object
   Dim k As Long, nbEmails As String, ListeAttaches As String, PassWd As String
   Dim appOutlook As Object, olMailItem As Object, olAttch As Object, kA As Long
   '--- Créer un nouvel item mail
   Set appOutlook = CreateObject("Outlook.Application")
   k = 0
   Set db = CurrentDb
   Set rs = db.OpenRecordset("qTemp", , dbReadOnly)      '--- requête qTemp contient la liste des adresses mail
   '--- note: le 'regroupement' dans la requête qTemp permet d'éviter l'envoi de plusieurs fois le même mail à la même adresse
   rs.MoveLast
   nbEmails = rs.RecordCount
   Me.EmailK.Visible = True
   Me.EmailDestinataire.Visible = True
   Me.DestEtiq.Visible = True
   rs.MoveFirst
   Do Until rs.EOF
      k = k + 1
      Me.EmailK = Str(k) & "/" & nbEmails    '--- affiche sur le formulaire la progression des envois (ne fait pas partie du message)
      Me.EmailDestinataire = rs!AdrMail
      'Debug.Print "Envoi à "; rs.Fields("AdrMail")
      Set olMailItem = appOutlook.CreateItem(0) 
      With olMailItem
         .To = rs.Fields("AdrMail")
         '.CC = ""
         '.BCC = ""
         .Subject = Me.EmailObjet
         ListeAttaches = Nz(Me.EmailAttached)
         If ListeAttaches <> "" Then
            Set olAttch = olMailItem.Attachments
            kA = InStr(ListeAttaches, ";")
            If kA = 0 Then
               olAttch.Add ListeAttaches
            Else
               While kA > 1
                  olAttch.Add Left(ListeAttaches, kA - 1)
                  ListeAttaches = Mid(ListeAttaches, kA + 2)   '--- 2 à cause de l'espace qui suit le ;
                  kA = InStr(ListeAttaches, ";")
               Wend
               olAttch.Add ListeAttaches                       '--- le dernier de la liste
            End If
         End If
         .BodyFormat = 3                     '--- olFormatRichText (non utilisable en Late Binding) = 3
         .HTMLBody = Me.EmailMessage
         '.Display                           '--- pour afficher avant d'envoyer
         .Send                               '--- pour envoyer sans demander
      End With
      Set olAttch = Nothing
      Set olMailItem = Nothing
      rs.MoveNext
   Loop
   Set appOutlook = Nothing
   rs.Close
   db.Close
   Set rs = Nothing
   Set db = Nothing
End Sub
 
Private Sub EmailViaAutre()
   Dim db As DAO.Database, rs As DAO.Recordset, objMessage As Object
   Dim k As Long, nbEmails As String, ListeAttaches As String, PassWd As String
   If Nz(Me.EmailPass, "?") = "?" Then
      PassWd = InputBox("Mot de passe : ", "A compléter", "?")
      If PassWd = "" Then
         If MsgBox("Etes-vous vraiment certain qu'il n'y a pas de mot de passe ?", vbExclamation + vbYesNo, "A confirmer") = vbNo Then
            MsgBox "Pas de mot de passe. Envoi annulé.", vbExclamation, "Envoi annulé"
            Me.EmailPass.SetFocus
            Exit Sub
         End If
      End If
   Else
      PassWd = Me.EmailPass
   End If
   k = 0
   Set db = CurrentDb
   Set rs = db.OpenRecordset("qTemp", , dbReadOnly)
   rs.MoveLast
   nbEmails = rs.RecordCount
   Me.EmailK.Visible = True
   Me.EmailDestinataire.Visible = True
   Me.DestEtiq.Visible = True
   '---
   Set objMessage = CreateObject("CDO.Message")
   With objMessage.Configuration.Fields
      .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2                     '--- network
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Me.EmailAdr
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Me.EmailPort
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1              '--- basic
      .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Me.EmailUserName
      .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PassWd
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = Me.EmailUseSSL
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
      .Update
   End With
   rs.MoveFirst
   With objMessage
      .Subject = Me.EmailObjet
      .From = Me.EmailReponse
      .HTMLBody = Me.EmailMessage
      '.Bcc = ""
      '.Cc = ""
      ListeAttaches = Nz(Me.EmailAttached)
      If ListeAttaches <> "" Then
         k = InStr(ListeAttaches, ";")
         If k = 0 Then
            .AddAttachment ListeAttaches
         Else
            While k > 1
               .AddAttachment Left(ListeAttaches, k - 1)
               ListeAttaches = Mid(ListeAttaches, k + 1)
               k = InStr(ListeAttaches, ";")
            Wend
         End If
      End If
      k = 0
      Do Until rs.EOF
         k = k + 1
         Me.EmailK = Str(k) & "/" & nbEmails    '--- affiche sur le formulaire la progression des envois (ne fait pas partie du message)
         Me.EmailDestinataire = rs!AdrMail
         .To = rs!AdrMail
         On Error GoTo panne
         .Send
         On Error GoTo 0
suite:
         rs.MoveNext
      Loop
   End With
fin:
   rs.Close
   db.Close
   Set rs = Nothing
   Set db = Nothing
   Exit Sub
panne:
   MsgBox "Cet email n'a pu être envoyé." & vbCrLf & _
          "Le mot de passe ou l'un des autres paramètres du compte n'est pas correct !", vbCritical, "Envoi annulé"
   GoTo fin
End Sub

En pièce jointe, un exemple pour tester. Il faudra ajouter des adresses !

Bonne continuation.

[Sam44310]

Bonjour,

Si je comprends bien je dois entrer une à une les adresses mail de ma liste d'association pour que ça fonctionne ?
Je ne peux pas le faire dans ma requete "association" qui me donne l'état "association" ?
Le but de ma base de données est de ne pas a avoir a changer à plusieurs endroits les coordonnées.
donc si je dois changer ou rajouter à deux endroits ça va être rédibitoire.
Peut être que ma question est tout simplement impossible au vu du peu de réponses

Merci tout de même d'avoir proposé cette solution.

[tee_grandbois]

Bonsoir,

Si je comprends bien je dois entrer une à une les adresses mail de ma liste d'association pour que ça fonctionne ?
Je ne peux pas le faire dans ma requete "association" qui me donne l'état "association" ?

il faut au minimum que l'adresse soit stockée dans un champ de la table (et donc de la requête). Si c'est le cas, il est possible d'envoyer le mail à tous les destinataires avec le code qu'a fourni EricDgn.

Set rs = db.OpenRecordset("qTemp", , dbReadOnly) : le RecordSet représente les données contenues dans le formulaire (propriété Source du formulaire).
Pour utilisation dans un formulaire l'instruction sera : Set rs = Me.RecordSet
rs.Fields("AdrMail") : le champ contenant l'adresse mail des destinataires dans le RecordSet.

[EricDgn]

Bonjour,

L'état "Associations" a sans doute comme source de données une requête, ayant par exemple le nom 'rListeAssoc'.
Dans cette requête 'rListeAssoc' il y a sans doute un champ indiquant l'adresse mail, ayant par exemple le nom 'AdrEmail'
Dans ce cas dans l'exemple précédent, il suffit de remplacer "qTemp" par "rListeAssoc", et "AdrMail" par "AdrEmail".
L'exemple n'est qu'une base de travail !

A noter que dans cet exemple, il est envoyé un email distinct à chaque adresse.
Le code pourrait être modifié pour préparer des groupes de destinataires (suite d'adresses mail séparés par des points-virgules) pour réduire le nombre d'envois. Dans ce cas le groupe d'adresses sera inscrit dans le champ .BCC (adresses des destinataires masquées à la réception).
Je dis "groupe de destinataires" car je crains qu'il y ait un nombre maximum admissible (ou une longueur de texte maximale). Il est possible que ce soit 400 ou 500 destinataires, mais pas certain. A tester.

Bonne continuation.

[Sam44310]

Bonjour,

Je vais regarder ça ce week-end, Merci beaucoup