Discussion :

[jul2012]

Bonjour,

J’ai une macro qui sert à envoyer des mails de manière automatique ligne par ligne.

Seulement il arrive que j’ai plusieurs lignes avec le même destinataire, mais je dois intégrer un corps de mail bien distinct malgré le fait que ce soit le même destinataire.

J’aimerais savoir comment je pourrais faire pour que ma macro envoi un seul mail par dentinaire, et que les corps de mail s’intègre les uns après les autres dans mon mail.

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
For i = 2 To Sheets("instruction mailing").Range("Q650000").End(xlUp).Row
  Set MonOutlook = CreateObject("Outlook.Application")
  Set monmessage = MonOutlook.CreateItem(0)
  monmessage.SentOnBehalfOfName = expediteur
  monmessage.display
  monmessage.To = Cells(i, 1)
  monmessage.Cc = "xxxx"
  monmessage.Subject = Cells(i, 2)
  corps = Cells(i, 3)
  corps = corps & vbCrLf & vbCrLf
  corps = corps & Cells(i, 4)
  corps = corps & vbCrLf
  corps = corps & Cells(i, 5)
  corps = corps & vbCrLf
  corps = corps & "xxxx"
  corps = corps & vbCrLf & vbCrLf
  corps = corps & Cells(i, 6)
  corps = corps & vbCrLf
  corps = corps & Cells(i, 7)
  monmessage.body = corps & monmessage.body
  monmessage.send
  Next i

[Daniel.C]

Bonjour,

Est-ce que toutes les cellules se trouvant dans la colonne du destinataire doivent être incluses dans le message ? Sinon, donne un exemple.

[jul2012]

En a2 par exemple j’ai un destinataire x avec les différentes données du corps de message en b2, c2, d2 etc une fois qu’il arrive au bout de la colonne q2, il envoie le mail. Ensuite ma macro crée un nouveau message ou elle intègre le destinataire en a3 et inclus les différentes données du corps de message en b3, c3, etc jusqu'à la colonne Q3.

Du coup, j’ai un mail qui part pour chaque ligne.

Dans mon exemple la cellule a2 et a3 ont la même adresse mail « x ».

Comment je pourrais faire pour que ma macro envoie seulement un seul mail.

C'est-à-dire que mon message inclurai le destinaire en a2 ou a3, peu importe puisque c’est le même destinataire mais par contre dans mon corps de message, il y aurai les données b2,c2,d2 etc et également les données b3,c3,d3, etc et pourquoi pas les données b4,c4 etc.. du moment que c’est le même destinataire.

Puis ma macro passerait à la ligne d’après etc
Cet exemple peut varier puisque je peux me retrouver avec 10 destinataires similaires par exemple.

En fait tant qu’il y a un destinataire similaire, elle envoie un seul mail.

Si tous les destinataires sont différents et que j’ai par exemple 10 lignes, la macro enverrait 10 messages

Est ce que cela peut t'aider ?

[Daniel.C]

Je ne l'ai pas testé, mais ça devrait le faire :

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
Sub test4()
Dim MonOutlook As Object, Col As Integer, Corps As String
Set MonOutlook = CreateObject("Outlook.Application")
With Sheets("instruction mailing")
    For i = 2 To .Range("Q650000").End(xlUp).Row
        Set monmessage = MonOutlook.CreateItem(0)
        monmessage.SentOnBehalfOfName = expediteur
        monmessage.display
        monmessage.To = .Cells(i, 1)
        monmessage.Cc = "xxxx"
        monmessage.Subject = .Cells(i, 2)
        Do
            For Col = 3 To .Cells(i, Columns.Count).End(xlToLeft).Column
                Corps = Corps & .Cells(i, Col).Value
                Corps = Corps & vbCrLf
            Next Col
        Loop While .Cells(i, 1) <> .Cells(i - 1, 1)
        monmessage.body = Corps & monmessage.body
        monmessage.send
    Next i
End With
End Sub

[patricktoulon]

bonjour

la méthode "find et find next" agrémentée d'un offset(x,y) ferait parfaitement l'affaire pour ce genre de travail


au plaisir

[jul2012]

Daniel,

cela semble être ce qu'il me faut mais il y a un problème, quand j'insère ton code et que je lance la macro, cela fait planter mon excel. j'ai l'impression que la boucle do ... loop while ne s'arrete jamais ?

A patrick :

Je ne connais pas find et find next. Comment peut-on s'en servir dans ce cas de figure.

J'apprend tout seul VBA, c'est pas facile. A part les boucles simples et certaines conditions. Ca reste assez difficile et pas donné à tout le monde de savoir faire ça !

Cordialement.

julien

[Daniel.C]

Oups, tu as parfaitement raison.

[patricktoulon]

re
voila un exemple en considérant que les adresses mail sont en colonne (A)
et les texte associé en colonne (B)et le tout dans le sheets(1)

colle ca dans un module standard

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
 
Option Explicit
Type donnee
    adressmail As String
    texte As String
End Type
 
Sub mailing()
    Dim destinataire(500) As donnee, i As Long, e As Long, d As Variant, cel As Range, elem As Variant, c As Range
    Dim firstAddress As String
    'on va lister la plage de nom en colonne A dans un dictionnaire pour en suprimer les doublons
    Set d = CreateObject("Scripting.Dictionary")
    For Each cel In Sheets(1).Range("a1:a10") 'dans la plage a1 a10 a toi d'adapter la tienne
        d.Item(cel.Value) = ""
    Next cel
    'on boucle sur tout les elements du dictionnaire
    For Each elem In d
        'dans la plage a1 a10 a toi d'adapter la tienne
        With Worksheets(1).Range("a1:a10")
            Set c = .Find(elem, LookIn:=xlValues)    'on cherche la valeur de elem
            If Not c Is Nothing Then    'si il existe
                firstAddress = c.Address
                i = i + 1
                destinataire(i).adressmail = elem
                Do
                    'on boucle sur toute les cellule pour voir si on ne trouve pas un nom identiquejusque qu'a qu'on soit arriver a la premiere
                    destinataire(i).texte = destinataire(i).texte & vbCrLf & c.Offset(0, 1)  ' et on inscrit dans le destinataire .texte la valeur de la cellule a droite des noms
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
    Next
    'un essaie dans un message box dans une boucle
    For e = 1 To i
   ' a la place du msgbox envoie le mail avec destinataire (e) .adressmail pour le destinataire 
'et destinataire(e).texte pour le contenu du message 
 
  MsgBox "il y a  " & i & "destinataires" & vbCrLf & vbCrLf & "Destinataire  " & e & "  " & destinataire(e).adressmail & vbCrLf & vbCrLf & "voici le texte qui y est associé " & vbCrLf & destinataire(e).texte
    Next
 
End Sub

au plaisir