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
|
Public Sub Envoi_Mail_DCO(typeMail As String, etatInitial As String)
' On définit tout nos objets
Dim OutApp As Object, OutMail As Object, Signature As String
Dim cell As Range, rng As Range, rngSelection As Range
Dim candidatsSheet As Worksheet, mailSheet As Worksheet
Dim eMail As String
Dim PRENOM As String
Dim NOM As String
Dim etatDCO As String, etatTest As String
Dim corpsTexte As String, formuleBonjour As String
Dim sujet As String
Dim ETAT As String
Dim colPrenom As Integer
Dim colNom As Integer
Dim colMail As Integer
Dim colDCO As Integer
Dim colTest As Integer
Dim colRelanceDCO As Integer
Dim colRelanceTest As Integer
Dim NombreEmails As Integer
NombreEmails = 0
Set OutApp = CreateObject("Outlook.Application")
Set candidatsSheet = Worksheets("CANDIDATS") ' Feuille des candidats
Set mailSheet = Worksheets("MAIL") ' Feuille des mails
Set rngSelection = Selection 'Sélection
'Trouver les colonnes
colPrenom = Cherche_ColonneXL(candidatsSheet, "PRENOM")
colNom = Cherche_ColonneXL(candidatsSheet, "NOM")
colMail = Cherche_ColonneXL(candidatsSheet, "MAIL")
colDCO = Cherche_ColonneXL(candidatsSheet, "DCO")
colTest = Cherche_ColonneXL(candidatsSheet, "TEST Technique")
colRelanceDCO = Cherche_ColonneXL(candidatsSheet, "RELANCE DCO")
colRelanceTest = Cherche_ColonneXL(candidatsSheet, "RELANCE TEST")
' On empêche la sélection de plusieurs lignes
If Selection.Columns.count > 1 Then
MsgBox "Merci de ne sélectionner qu'une seule colonne. Vous pouvez uniquement sélectionner plusieurs lignes.", vbExclamation, "Erreur"
Exit Sub
Else
' On récupère la signature enregistrée dans Outlook
Set OutMail = OutApp.CreateItem(0)
Signature = OutMail.HTMLBody
OutMail.Close False ' Ferme le mail utilisé pour récupérer la signature sans l'envoyer
On Error Resume Next
Set rng = rngSelection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "Il n'y a pas de cellules visibles dans la sélection."
Exit Sub
End If
For Each cell In rng
eMail = candidatsSheet.Cells(cell.Row, colMail).Value
PRENOM = candidatsSheet.Cells(cell.Row, colPrenom).Value
NOM = candidatsSheet.Cells(cell.Row, colNom).Value
etatDCO = candidatsSheet.Cells(cell.Row, colDCO).Value
etatTest = candidatsSheet.Cells(cell.Row, colTest).Value
If eMail <> "" And Not cell.EntireRow.Hidden Then
If etatDCO = "Pas envoyé" And typeMail = "DCO" And etatInitial = "Pas envoyé" Then
ETAT = "DCO - Pas envoyé"
ElseIf etatDCO = "Envoyé / Pas réalisé" And typeMail = "DCO" And etatInitial = "Envoyé / Pas réalisé" Then
ETAT = "DCO - Envoyé / Pas réalisé"
ElseIf etatTest = "Pas envoyé" And typeMail = "TEST" And etatInitial = "Pas envoyé" Then
ETAT = "TEST - Pas envoyé"
ElseIf etatTest = "Envoyé / Pas réalisé" And typeMail = "TEST" And etatInitial = "Envoyé / Pas réalisé" Then
ETAT = "TEST - Envoyé / Pas réalisé"
Else
GoTo NextIteration
End If
NombreEmails = NombreEmails + 1
corpsTexte = mailSheet.Cells(Application.Match(ETAT, mailSheet.Range("A:A"), 0), 2).Value
sujet = mailSheet.Cells(Application.Match(ETAT, mailSheet.Range("A:A"), 0), 3).Value
formuleBonjour = "Bonjour " & PRENOM & " " & NOM & ",<br><br>"
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = eMail
.Subject = sujet
.Display ' Affiche l'aperçu avant d'envoyer encore une fois
.HTMLBody = formuleBonjour & corpsTexte & "<br>" & .HTMLBody
End With
Set OutMail = Nothing
End If
NextIteration:
Next cell
If NombreEmails = 0 Then ' Si aucun e-mail n'a été envoyé
MsgBox "Aucun e-mail ne correspond à votre relance. Veuillez vérifier les conditions de votre sélection."
End If
End If
Set OutApp = Nothing
End Sub |
