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
| Private Sub but_mail_Click() 'envoi du mail du lundi
'déclaration des variable
Dim qry As DAO.QueryDef
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim rst1 As DAO.Recordset
Dim sSQL As String
Dim sSQL1 As String
Dim j As Variant
Dim j1 As Variant
Dim destinataires As String
Dim copies As String
Dim Vdate_debut As Variant
Dim Vdate_date_fin As Variant
Vdate_debut = txt_date_debut.Value
Vdate_date_fin = txt_date_fin.Value
Vnom_immo = txt_nom_immo.Value
Vprenom_immo = txt_prenom_immo.Value
Vmail_immo = txt_mail_immo.Value
Vn1_immo = txt_num1_immo.Value
Vn2_immo = txt_num2_immo.Value
Vn3_immo = txt_num3_immo.Value
Vnom_BCM = txt_nom_BCM.Value
Vprenom_BCM = txt_prenom_BCM.Value
Vmail_BCM = txt_mail_BCM.Value
Vn1_BCM = txt_num1_BCM.Value
Vn2_BCM = txt_num2_BCM.Value
Vn3_BCM = txt_num3_BCM.Value
Vcomment = txt_commentaire.Value
'requete de selection des destinataires
sSQL = "SELECT T_adresse_mail.mail" & _
" FROM T_adresse_mail" & _
" WHERE (T_adresse_mail.type_envoi = 'dest') AND T_adresse_mail.type_liste Like '*Plhebdo*';"
'requete de selection des copies
sSQL1 = "SELECT T_adresse_mail.mail" & _
" FROM T_adresse_mail" & _
" WHERE (T_adresse_mail.type_envoi = 'copie') AND T_adresse_mail.type_liste Like '*Plhebdo*';"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
Set rst1 = dbs.OpenRecordset(sSQL1, dbOpenSnapshot)
'boucle venant alimenter la variable destinataires du résultat de la requete rst
For j = 0 To rst.Fields.Count - 1
Next j
Do Until rst.EOF
For j = 0 To rst.Fields.Count - 1
destinataires = rst.Fields(j).Value
Next j
rst.MoveNext
Loop
'boucle venant alimenter la variable copies du résultat de la requete rst
For j1 = 0 To rst1.Fields.Count - 1
Next j1
Do Until rst.EOF
For j1 = 0 To rst1.Fields.Count - 1
destinataires = rst1.Fields(j).Value
Next j1
rst1.MoveNext
Loop
'Création du mail
Dim OutApp As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Recipient
Dim Recipients As Recipients
Set OutApp = CreateObject("Outlook.Application")
Set objOutlookMsg = OutApp.CreateItem(olMailItem)
'destinataire
Set Recipients = objOutlookMsg.Recipients
Set objOutlookRecip = Recipients.Add(destinataires) 'mails des destinataires
'Set objOutlookRecip = rst.Fields(0) 'mails des destinataires 'ne fonctionne pas
'copie
objOutlookMsg.CC = (copies) 'mails des copies
'objOutlookMsg.CC = rst1.Fields(0) 'mails des copies
objOutlookRecip.Type = 1
'expéditeur
objOutlookMsg.SentOnBehalfOfName = "locaux-par-astreinte-gbis.acces@sgcib.com" ' insertion de l'adresse expéditrice
'niveau d'importance
objOutlookMsg.Importance = olImportanceHigh
'objet du mail
objOutlookMsg.Subject = " Planning d'astreinte de la semaine du : " & Vdate_debut & " au " & Vdate_fin ' objet avec intégration des éléments"
'création du corps de texte
....... suite du code en cours |
Partager