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
| Dim Destinataire As String
Dim Sql_Mail As String
Dim oEmail As Outlook.MailItem
Dim appOutLook As Outlook.Application
Dim oRst1 As DAO.Recordset
Dim oDB As DAO.Database
initerr = False
Err_detect_mail (initerr)
Set oDB = CurrentDb
'Création de la requete de regrouppement
Sql_Mail = "SELECT Tbl_LUP_EMAIL.adressemail, Tbl_LUP_EMAIL.Login, Tbl_LUP_EMAIL.Par FROM Tbl_LUP_EMAIL GROUP BY Tbl_LUP_EMAIL.adressemail, Tbl_LUP_EMAIL.Login, Tbl_LUP_EMAIL.Par HAVING (((Tbl_LUP_EMAIL.Par)=GetLoginUser()));"
' créer un nouvel item mail
Set appOutLook = New Outlook.Application
Set oEmail = appOutLook.CreateItem(olMailItem)
' les paramètres
Set oRst1 = oDB.OpenRecordset(Sql_Mail)
'Boucle sur chaque client et les ajoute au champ A du mail
While Not oRst1.EOF
moi = oRst1.Fields("Login")
If moi <> GetLoginUser Then
Destinataire = Destinataire & oRst1.Fields("adressemail") & "; "
End If
oRst1.MoveNext
Wend
If Destinataire <> "" Then
'Supprime le ";" à la fin
Destinataire = Left(Destinataire, Len(Destinataire) - 2)
' Mise en forme du mail
'oEmail.To = Destinataire
oEmail.Subject = "Portail Maintenance : Mise à jour de votre LUP"
oEmail.Body = "Bonjour"
' envoie le message
oEmail.Send
' détruit les références aux objets
Set oEmail = Nothing
Set appOutLook = Nothing
End if |
Partager