Discussion :

[bryval]

Bonjour à tous
J’espère qu'il y aura une personne qui saura répondre à mon problème de programmation. Cela faisait plus d'un an que je n'avais pas programmé avec VBA et je sèche un peu la sur ce que l'on me demande. Je décris mon problème de la manière la plus simple : je souhaite automatiser un envois de mail avec outlook, avec un objet et un message différent en fonction des choix faits dans deux cellules.
à partir d'un fichier excel , où il y figure
- feuille 1 : sur une même ligne, une adresse mail (destinataire), une adresse mail (en CC), une cellule avec deux choix possible (salarié ou indépendant) et une cellule avec le type de mail (5 choix différents mais cela n'est pas important de le détailler)
- feuille 2 : selon le choix fait (salarié ou indépendant) et selon le choix fait sur le type de mail (5 choix possibles), il y a un objet qui s'ajoute au mail et un message écrit.

Donc pour résumer, en cliquant sur un bouton affectée d ela macro ci dessus, je souhaite que mon programme envois, pour chaque ligne, un mail avec le destinataire, le mail CC, un fichier, et SURTOUT un objet + un message variable.
J'ai déjà réussi a faire cette macro, mais seulement pour une seule ligne ... et j'ai essayer d'inclure une boucle while wend mais cela ne marche pas et je commence à désespérer.

Merci d'avance pour une éventuelle aide.

Voici la macro :

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
139
Sub Commandbutton1_click()
 
    If MsgBox("Souhaitez-vous envoyer le mail ?", vbYesNo, "Demande de confirmation pour l'envoi du mail") = vbYes Then
 
        Dim Ouvriroutlook As Object
        Dim OuvrirMessage As Object
        Dim AdresseMail As String
        Dim AdresseMAilIA As String
        Dim SalariéSubject1 As String 'toutes ces variables sont les differents objet et message  a inclure 
        Dim SalariéBody1 As String
        Dim SalariéSubject2 As String
        Dim SalariéBody2 As String
        Dim SalariéSubject3 As String
        Dim SalariéBody3 As String
        Dim SalariéSubject4 As String
        Dim SalariéBody4 As String
        Dim SalariéSubject5 As String
        Dim SalariéBody5 As String
        Dim IndépendantSubject1 As String
        Dim IndépendantBody1 As String
        Dim IndépendantSubject2 As String
        Dim IndépendantBody2 As String
        Dim IndépendantSubject4 As String
        Dim IndépendantBody4 As String
        Dim IndépendantSubject5 As String
        Dim IndépendantBody5 As String
        Dim i As Integer
 
        Set Ouvriroutlook = CreateObject("Outlook.Application")
        Set OuvrirMessage = Ouvriroutlook.CreateItem(0)
 
        i = 5
 
        AdresseMail = Worksheets("Tableau").Cells(i, 3)
        AdresseMAilIA = Worksheets("Tableau").Cells(i, 6)
 
        SalariéSubject1 = Worksheets("Annexe").Cells(2, 3)
        SalariéBody1 = Worksheets("Annexe").Cells(2, 4)
        SalariéSubject2 = Worksheets("Annexe").Cells(3, 3)
        SalariéBody2 = Worksheets("Annexe").Cells(3, 4)
        SalariéSubject3 = Worksheets("Annexe").Cells(4, 3)
        SalariéBody3 = Worksheets("Annexe").Cells(4, 4)
        SalariéSubject4 = Worksheets("Annexe").Cells(5, 3)
        SalariéBody4 = Worksheets("Annexe").Cells(5, 4)
        SalariéSubject5 = Worksheets("Annexe").Cells(6, 3)
        SalariéBody5 = Worksheets("Annexe").Cells(6, 4)
        IndependantSubject1 = Worksheets("Annexe").Cells(7, 3)
        IndependantBody1 = Worksheets("Annexe").Cells(7, 4)
        IndependantSubject2 = Worksheets("Annexe").Cells(8, 3)
        IndependantBody2 = Worksheets("Annexe").Cells(8, 4)
        IndependantSubject4 = Worksheets("Annexe").Cells(10, 3)
        IndependantBody4 = Worksheets("Annexe").Cells(10, 4)
        IndependantSubject5 = Worksheets("Annexe").Cells(11, 3)
        IndependantBody5 = Worksheets("Annexe").Cells(11, 4)
 
        While AdresseMail <> ""
 
                If Statut = "Salarié" And Relance = "Démarrage" Then
 
                    With OuvrirMessage
                     .To = AdresseMail
                     .Subject = SalariéSubject1
                     .CC = AdresseMAilIA
                     .Body = SalariéBody1
                     .Attachments.Add ("C:\Users\bvalleti\Desktop\Florent\ModèleFichedePoste.doc")
                     .Send
                    End With
 
                Returnreceipt = True
 
 
                ElseIf Statut = "Salarié" And Relance = "1ère Relance" Then
                    With OuvrirMessage
                    .To = AdresseMail
                    .Subject = SalariéSubject2
                    .CC = AdresseMAilIA
                    .Body = SalariéBody2
                    .Attachments.Add ("C:\Users\bvalleti\Desktop\Florent\ModèleFichedePoste.doc")
                    .Send
 
                    End With
 
                Returnreceipt = True
 
 
                ElseIf Statut = "Salarié" And Relance = "2ème Relance" Then
                    With OuvrirMessage
                    .To = AdresseMail
                    .Subject = SalariéSubject3
                    .CC = AdresseMAilIA
                    .Body = SalariéBody3
                    .Attachments.Add ("C:\Users\bvalleti\Desktop\Florent\ModèleFichedePoste.doc")
                    .Send
 
                    End With
 
                Returnreceipt = True
 
 
                ElseIf Statut = "Salarié" And Relance = "Changement mission" Then
                    With OuvrirMessage
                    .To = AdresseMail
                    .Subject = SalariéSubject4
                    .CC = AdresseMAilIA
                    .Body = SalariéBody4
                    .Attachments.Add ("C:\Users\bvalleti\Desktop\Florent\ModèleFichedePoste.doc")
                    .Send
 
                    End With
 
                Returnreceipt = True
 
 
                ElseIf Statut = "Salarié" And Relance = "Changement mission relance" Then
                    With OuvrirMessage
                    .To = AdresseMail
                    .Subject = SalariéSubject5
                    .CC = AdresseMAilIA
                    .Body = SalariéBody5
                    .Attachments.Add ("C:\Users\bvalleti\Desktop\Florent\ModèleFichedePoste.doc")
                    .Send
 
                    End With
 
                End If
 
                i = i + 1   'surligné en jaune ce qui est le problème
 
            Wend
 
        MsgBox "Le mail a bien été envoyé à "
 
    Else
 
    MsgBox ("Les mails n'ont pas été envoyés")
 
    End If
 
End Sub