grosquick59
Messages postés50Date d'inscriptionvendredi 15 août 2008StatutMembreDernière intervention29 novembre 2010
-
25 nov. 2010 à 00:33
grosquick59
Messages postés50Date d'inscriptionvendredi 15 août 2008StatutMembreDernière intervention29 novembre 2010
-
25 nov. 2010 à 23:07
Salut
je souhaite envoyer un mail type à plusieurs destinataires via Excel.
Les destinataires se trouvent dans une colonne E.
Dans la colonne F j'indique oui ou non. (oui = envoi mail)
Le problème est que j'ai un mail par destinataire ce qui est impossible à gérer. Je souhaiterai que toutes les adresses mail de la colonne E soient en destinataire dans un seul e-mail.
Voici mon code :
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("E").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "F").Value) = "oui" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Infos"
.Body = "Bonjour, xxxxxxxxxxxxxx"
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
J'espère que je suis assez clair ^^
Par avance, merci.
A voir également:
Envoyer un mail à plusieurs destinataires excel
Vba excel envoi mail plusieurs destinataires - Meilleures réponses
rv83toulon
Messages postés68Date d'inscriptionmercredi 2 mars 2011StatutMembreDernière intervention25 avril 2013 25 nov. 2010 à 10:03
Bonjour,
pour suivre l'idée de c148270 :
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range, x As Integer
Dim mesdestinataires As String
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("E").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "F").Value) "oui" Then mesdestinataires cell.Value & "; " & mesdestinataires
Next cell
x = Len(mesdestinataires) - 2
nbritem = Left(mesdestinataires, x)
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = mesdestinataires
.Subject = "Infos"
.Body = "Bonjour, xxxxxxxxxxxxxx"
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True