Envoi mail groupé
Bonjour à tous,
Je vous explique ma problématique.
Je voudrai envoyer en un clique un mail à toute mes adresses mails contenu dans mon classeur. Qui pleuvent être dans différentes cellules.
J'ai déjà mis en place une vba qui me permet de le faire pour chaque onglet avec un raccourci mais je voudrai le faire pour tout mon classeur...
Pouvez vous m'aider ?
Merci à tous,
Je vous explique ma problématique.
Je voudrai envoyer en un clique un mail à toute mes adresses mails contenu dans mon classeur. Qui pleuvent être dans différentes cellules.
J'ai déjà mis en place une vba qui me permet de le faire pour chaque onglet avec un raccourci mais je voudrai le faire pour tout mon classeur...
Pouvez vous m'aider ?
Merci à tous,
1 réponse
-
ci-dessous code pour l'ensemble du classeur
Sub envoi_mail()
Dim feuille As Worksheet
Dim cellule As Range
For Each feuille In ThisWorkbook.Sheets
If Evaluate("COUNTIF(" & feuille.UsedRange.Address & ",""*@*.*"")") > 0 Then 'au moins une adresse mail présente dans la feuille
For Each cellule In feuille.UsedRange.Cells 'cellules utilisées de la feuille
If cellule Like "*@*.*" Then
'votre code d'envoi du mail ...... avec la variable cellule contenant l'adresse du destinataire
End If
Next
End If
Next
End Sub
-
-
Le code tourne en rond,
Sub envoi_mail3()
Dim feuille As Worksheet
Dim cellule As Range
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
For Each feuille In ThisWorkbook.Sheets
If Evaluate("COUNTIF(" & feuille.UsedRange.Address & ",""*@*.*"")") > 0 Then 'au moins une adresse mail présente dans la feuille
For Each cellule In feuille.UsedRange.Cells 'cellules utilisées de la feuille
If cellule Like "*@*.*" Then
End If
Next
' Working in Office 2000-2016
Set OutApp = CreateObject("Outlook.Application")
MsgBox ("Préparation du MAIL pour envoie du catalogue PLV Flexico. " & Chr(10) & Chr(10) & "La fenêtre du message va s'afficher" & Chr(10) & "Merci de valider l'envoi")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.Display
.To = Range("L2").Value
.CC = ""
.BCC = ""
.Subject =
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
Next
End Sub -
@sandrineBonjour,
Votre code n'est pas inséré au bon endroit et il manque l'instruction send pour envoyer le mail.
Ci-dessous code
Sub envoi_mail3()
Dim feuille As Worksheet
Dim cellule As Range
Dim OlApp As Object
Dim email As Object
Set OlApp = CreateObject("Outlook.Application") 'création instance application outlook
For Each feuille In ThisWorkbook.Sheets
If Evaluate("COUNTIF(" & feuille.UsedRange.Address & ",""*@*.*"")") > 0 Then 'au moins une adresse mail présente dans la feuille
For Each cellule In feuille.UsedRange.Cells 'cellules utilisées de la feuille
If cellule.Value Like "*@*.*" Then
' Working in Office 2000-2016
MsgBox ("Préparation du MAIL pour envoie du catalogue PLV Flexico. " & Chr(10) & Chr(10) & "La fenêtre du message va s'afficher" & Chr(10) & "Merci de valider l'envoi")
Set email = OlApp.CreateItem(olMailItem)
On Error Resume Next
With email
.Display
.To = cellule.Value 'destinataire
.CC = ""
.BCC = ""
.Subject = "Votre objet"
.Body = "Corps du mail"
.Send ' envoie le message
End With
On Error GoTo 0
Set email = Nothing
End If
Next
End If
Next
Set OlApp = Nothing
End Sub
-
