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
| Function mail_RES(mess_data As données_message) As données_message
Application.ScreenUpdating = False
Dim vCnx As New ADODB.Connection 'Accès ADO
Dim vT_DestMail As New ADODB.Recordset 'Visu table tab_indispo via accès ADO
Dim feuille_data As Worksheet
Dim i As Integer
Dim acc_prov, access_source As String
Dim dest(10) 'Dimensionner le tableau
Dim resultat() As String
Dim i_ligne As Integer
i = 2
fich_macro = "AMAPE Hydrant.xlsm"
Set feuille_data = Worksheets("Export")
mail_RES = mess_data
ville = mess_data.commune
num_insee = mess_data.INSEE
'Initialisation des liens avec access
acc_prov = "microsoft.ACE.OLEDB.12.0" 'Provider pour la version 2010
access_source = Workbooks(fich_macro).Worksheets("Paramètres").Range("BD") 'chemin réseau de la bdd
vCnx.ConnectionString = "provider=" & acc_prov & ";data source=" & access_source
vCnx.Open
'requete destinataires
sql_request = "SELECT [Mail Destinataire] from tab_DestinataireMail WHERE ((tab_DestinataireMail.[Code INSEE])='" _
& num_insee & "') AND ((tab_DestinataireMail.RES)=True) AND ((tab_DestinataireMail.type_cc)=False)"
vT_DestMail.Open sql_request, vCnx, adOpenDynamic, adLockOptimistic 'création de la table résultant de la requète de sélection
With vT_DestMail
.MoveFirst
While Not .EOF
feuille_data.Range("W" & i) = vT_DestMail.Fields("Mail Destinataire") 'on copie les mails des destinataires
i = i + 1
.MoveNext
Wend
End With
vT_DestMail.Close 'libérer la zone mémoire de la table
'requete destinataires cc
sql_request = "SELECT [Mail Destinataire] from tab_DestinataireMail WHERE ((tab_DestinataireMail.[Code INSEE])='" _
& num_insee & "') AND ((tab_DestinataireMail.RES)=True) AND ((tab_DestinataireMail.type_cc)=True)"
vT_DestMail.Open sql_request, vCnx, adOpenDynamic, adLockOptimistic 'création de la table résultant de la requète de sélection
'i = 2
'Partie Aquérir les données
With vT_DestMail
.MoveFirst
While Not .EOF
feuille_data.Range("Y" & i) = vT_DestMail.Fields("Mail Destinataire") 'on copie les mails des destinataires à partir de la colonne H
i = i + 1
.MoveNext
Wend
End With
vT_DestMail.Close 'libérer la zone mémoire de la table
Set vT_DestMail = Nothing 'vider l'espace mémoire de la table
'Quand on récupère la liste des destinataires, on met un point virgule entre chaque destinataire
destinataire = ""
For i = 1 To 5
If feuille_data.Range("W" & i) <> "" Then
If i > 1 Then
destinataire = destinataire & ","
End If
destinataire = destinataire & feuille_data.Range("W" & i)
End If
Next i
mail_RES.destinataire = destinataire
desti_cc = ""
For i = 1 To 2
If feuille_data.Range("Y" & i) <> "" Then
If i > 1 Then
desti_cc = desti_cc & ","
End If
desti_cc = desti_cc & feuille_data.Range("AB" & i)
End If
Next i
mail_RES.dest_cc = desti_cc
" |
Partager