Envoyer un mail auto avec plusieurs données selon critère

**soadadrinker** · 27/05/2013, 23h41

Bonjour,

J'ai une liste de numéros sur une colonne et une liste de contacts mails sur une autre.

J'aimerais alors développer une macro pour envoyer automatiquement des mails aux contacts de la colonne "Dest" en reprenant les infos de ma colonne "Numéro" leur correspondant.
Jusque là encore ca irait. Le souci c'est que plusieurs numéros peuvent être liés à une seule et même personne et j'aimerais alors qu'un seul email soit envoyé aux personnes avec l'ensemble des numéros qui vont avec.
Avez-vous une idée?

Voici ce que j'ai développé jusque là mais qui bah ne fonctionne pas....

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
Sub Envoi()
   Dim OlApp As Outlook.Application
    Dim OlItem As Outlook.MailItem
 
    Set OlApp = CreateObject("Outlook.application")
    Set OlItem = OlApp.CreateItem(olMailItem)
 
 
For i = 2 To 9
Set OlItem = OlApp.CreateItem(olMailItem)
 
     With OlItem
 
nom = Sheets("Mailing").Cells(i, 1)
dest = Sheets("Mailing").Cells(i, 4)
 
        .To = dest
        .Subject = "Numéro"
        .BodyFormat = olFormatHTML
        .HTMLBody = "<HTML><body>" _
             & "Bonjour " & nom & ",<p>" _
    & "Voici donc les numéros vous concernant <p>" _
 
    y = 0
While y = Sheets("Mailing").Cells(i, 9)
  .BodyFormat = olFormatHTML
        .HTMLBody = "<HTML><body>" _
& "Numéro<b><font color='blue'> " & Sheets("Mailing").Cells(i + y - 1, 3) & "</font></b>.<br>" _
& "</body><HTML>"
y = y + 1
Wend
.BodyFormat = olFormatHTML
        .HTMLBody = "<HTML><body>" _
        & "Merci encore. <br>" _
    & " <p>" _
    & "Bonne journée. <p>" _
    & "</body><HTML>"
 
        '.Display
        .Send
    End With
Next i
End Sub

Je vous joins le fichier en question.

Merci.

Invité · 28/05/2013, 16h30

Bonjour,

Une solution possible avec ce code :

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
 
Sub Envoi()
 
' Eric KERGRESSE EIRL
 
Dim OlApp As Outlook.Application
Dim OlItem As Outlook.MailItem
 
Dim MatriceEnvoi() As Variant
Dim LigneDeTitre As Long
Dim DerniereLigne As Long
Dim AireMailing As Range
Dim CelluleMailing As Range
Dim CtrI As Long
Dim Continuer As Boolean
 
 
    LigneDeTitre = 1
    DerniereLigne = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
 
    Set AireMailing = Range(Cells(LigneDeTitre + 1, 1), Cells(DerniereLigne, 1))
 
    ReDim MatriceEnvoi(2, 0)
    MatriceEnvoi(0, 0) = Cells(LigneDeTitre + 1, 1)
 
    ' Dénombrement des mails à envoyer
    For Each CelluleMailing In AireMailing
 
            Continuer = True
 
            For CtrI = LBound(MatriceEnvoi, 2) To UBound(MatriceEnvoi, 2)
                Select Case MatriceEnvoi(0, CtrI)
                    Case CelluleMailing
                        Continuer = False
                        Exit For
                End Select
 
            Next CtrI
 
            If Continuer = True Then
                ReDim Preserve MatriceEnvoi(2, UBound(MatriceEnvoi, 2) + 1)
                MatriceEnvoi(0, UBound(MatriceEnvoi, 2)) = CelluleMailing
            End If
 
    Next CelluleMailing
 
    ' Chargement des adresses mail et des numéros dans MatriceEnvoi
    For CtrI = LBound(MatriceEnvoi, 2) To UBound(MatriceEnvoi, 2)
 
            For Each CelluleMailing In AireMailing
 
                        Select Case MatriceEnvoi(0, CtrI)
                            Case CelluleMailing
                               MatriceEnvoi(1, CtrI) = CelluleMailing.Offset(0, 1)
                               MatriceEnvoi(2, CtrI) = MatriceEnvoi(2, CtrI) & CelluleMailing.Offset(0, 2) & ", "
                        End Select
 
            Next CelluleMailing
 
    Next CtrI
 
    ' Envoi des mails
    Set OlApp = CreateObject("Outlook.application")
 
    For CtrI = LBound(MatriceEnvoi, 2) To UBound(MatriceEnvoi, 2)
 
        Set OlItem = OlApp.CreateItem(olMailItem)
        With OlItem
 
                .To = MatriceEnvoi(1, CtrI)
                .Subject = "Numéro"
                .BodyFormat = olFormatHTML
                .HTMLBody = "<HTML><body>" _
                     & "Bonjour " & MatriceEnvoi(0, CtrI) & ",<p>" & " <p>" _
                     & "Voici donc le ou les numéro(s) vous concernant : <p>" _
                     & "<b><font color='blue'> " & MatriceEnvoi(2, CtrI) & "</font></b><br>" & " <p>" _
                     & "Merci encore. <br>" _
                        & " <p>" _
                        & "Bonne journée. <p>" _
                        & "</body><HTML>"
 
                '.Display
                .Send
         End With
 
    Next CtrI
 
   Set AireMailing = Nothing
 
End Sub

Dans le fichier joint, il ne reste plus que 3 colonnes : Nom, Mail, Numéros.

Cordialement.

**soadadrinker** · 28/05/2013, 18h13

Hello,

Ca m'a l'air pas mal du tout! Par contre, le code s'est pas mal complexifié et j'aurais sans doute un peu de mal à le faire évoluer au besoin.
Je pense en particulier à comment je peux rajouter d'autres colonnes dans l'email?

Dans le sens,
je voyais le faire évoluer en attribuant un sous-numéro à un numéro

Type:

" bonjour X,

Voici vos numéros:
12434 / ASV
45687 / ASV
7897 / WRE

Merci.

Bonne journée."

2 informations selon 2 colonnes (la 3e et 4e ici) et qui se rajoutent en colonne dans l'email plutôt que par virgule.

Je vais regarder de mon côté aussi si je trouve l'astuce.

Merci.

Invité · 28/05/2013, 23h31

Pour ajouter des colonnes, il faut simplement les ajouter à la colonne 2 de la matrice en concaténant les champs.
Pour faire des sauts de ligne, il faut intégrer les balises html dans la colonne 2 de la matrice.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MatriceEnvoi(2, CtrI) = "<HTML><body>" & MatriceEnvoi(2, CtrI) & CelluleMailing.Offset(0, 2) & " / " & CelluleMailing.Offset(0, 3) & "<p>" & "</body><HTML>"

Le code est modifié de la façon suivante :

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
Sub Envoi()
 
' Eric KERGRESSE EIRL
 
Dim OlApp As Outlook.Application
Dim OlItem As Outlook.MailItem
 
Dim MatriceEnvoi() As Variant
Dim LigneDeTitre As Long
Dim DerniereLigne As Long
Dim AireMailing As Range
Dim CelluleMailing As Range
Dim CtrI As Long
Dim Continuer As Boolean
 
 
    LigneDeTitre = 1
    DerniereLigne = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
 
    Set AireMailing = Range(Cells(LigneDeTitre + 1, 1), Cells(DerniereLigne, 1))
 
    ReDim MatriceEnvoi(2, 0)
    MatriceEnvoi(0, 0) = Cells(LigneDeTitre + 1, 1)
 
    ' Dénombrement des mails à envoyer
    For Each CelluleMailing In AireMailing
 
            Continuer = True
 
            For CtrI = LBound(MatriceEnvoi, 2) To UBound(MatriceEnvoi, 2)
                Select Case MatriceEnvoi(0, CtrI)
                    Case CelluleMailing
                        Continuer = False
                        Exit For
                End Select
 
            Next CtrI
 
            If Continuer = True Then
                ReDim Preserve MatriceEnvoi(2, UBound(MatriceEnvoi, 2) + 1)
                MatriceEnvoi(0, UBound(MatriceEnvoi, 2)) = CelluleMailing
            End If
 
    Next CelluleMailing
 
 
    ' Envoi des mails
    Set OlApp = CreateObject("Outlook.application")
 
    For CtrI = LBound(MatriceEnvoi, 2) To UBound(MatriceEnvoi, 2)
 
        ContenuMessage = ""
        For Each CelluleMailing In AireMailing
                 Select Case MatriceEnvoi(0, CtrI)
                        Case CelluleMailing
                             MatriceEnvoi(1, CtrI) = CelluleMailing.Offset(0, 1)
                             MatriceEnvoi(2, CtrI) = "<HTML><body>" & MatriceEnvoi(2, CtrI) & CelluleMailing.Offset(0, 2) & " / " & CelluleMailing.Offset(0, 3) & "<p>" & "</body><HTML>"
                 End Select
        Next CelluleMailing
 
        Set OlItem = OlApp.CreateItem(olMailItem)
        With OlItem
 
                .To = MatriceEnvoi(1, CtrI)
                .Subject = "Numéro"
                .BodyFormat = olFormatHTML
                .HTMLBody = "<HTML><body>" _
                     & "Bonjour " & MatriceEnvoi(0, CtrI) & ",<p>" & " <p>" _
                     & "Voici donc le ou les numéro(s) vous concernant : <p>" _
                     & "<b><font color='blue'> " & MatriceEnvoi(2, CtrI) & "</font></b><br>" & " <p>" _
                     & "Merci encore. <br>" _
                        & " <p>" _
                        & "Bonne journée. <p>" _
                        & "</body><HTML>"
 
                '.Display
                .Send
         End With
 
    Next CtrI
 
   Set AireMailing = Nothing
 
End Sub

Cordialement.

**soadadrinker** · 29/05/2013, 14h11

Re-salut et merci pour tous ces efforts! Ca marche nickel et j'arrive à ajouter des colonnes au besoin donc c'est juste parfait.
Juste un dernier point peut être: j'ai remarqué que la macro prenait en compte le nom plus que le mail pour le recoupement des données.

Je m'explique. En faisant un test avec les données suivantes:

Nompersonne1 1@exemple.com 1
Nompersonne1 1@exemple.com 2
Nompersonne2 1@exemple.com 3
Nompersonne2 2@exemple.com 4
Nompersonne2 2@exemple.com 5
Nompersonne1 1@exemple.com 6
Nompersonne2 2@exemple.com 7

J'arrive à ca grosso modo:

pour mail 1@exemple.com:
Bonjour nompersonne1, voici vos numéros:
1
2
6

pour mail 2@exemple.com:
Bonjour nompersonne2, voici vos numéros:
3
4
5
7

Selon les cas, j'aimerais aussi avoir:

pour mail 1@exemple.com:
Bonjour, voici vos numéros:
1
2
3
6

pour mail 2@exemple.com:
Bonjour, voici vos numéros:
4
5
7

Avec les noms je vais m'embrouiller ici. Est-ce qu'on pourrait avoir un code simplifié sur un autre fichier du coup sans le nom de le personne mais qui prendrait uniquement les mails en compte?

Merci encore.

**soadadrinker** · 02/06/2013, 22h48

Humm, plus personne?

**soadadrinker** · 11/06/2013, 00h10

arffff, plus personne sur la dernière ligne droite?

Envoyer un mail auto avec plusieurs données selon critère

Macros et VBA Excel

Discussions similaires

Partager

Partager