Macro Excel outlook - Envoie de mails automatiquement [Résolu/Fermé]

Signaler
Messages postés
4
Date d'inscription
jeudi 5 décembre 2013
Statut
Membre
Dernière intervention
5 décembre 2013
-
Bruce Willix
Messages postés
12594
Date d'inscription
mardi 24 mai 2011
Statut
Contributeur
Dernière intervention
12 juin 2018
-
J'ai trouvé un code sur internet qui envoie mon mail à tous les adresses que j'ai sur excel d'un seul coup. J'aimerais le modifier afin qu'il envoie le mail aux adresses de manière séparée. Par exemple si on a 10 adresses on aura dix mails envoyés séparément.
Je vous remercie d'avance de votre aide.

Voici le code à modifier :
Option Explicit

Sub envoi_Feuille()
Dim olapp As Outlook.Application
Dim malist, Count, Envoi, AdresseRépertoire As Variant
On Error Resume Next
'-------Contrôler dans Bisual Basic/Outils/Références/que Microsoft Outlook --,- Object Librairy est bien coché
Dim adresse(1 To 10)
'----------------------Création de la liste d'adresses mail contenus de la ligne 2 à 10
Set malist = Sheets("Feuil1").Range("A2:A10")
Count = 1
For Each Envoi In malist
If Len(Envoi) Then adresse(Count) = Envoi: Count = Count + 1
Next
'----------------------Copie de la liste d'adresse dans une cellule vide exemple H1
[H1] = Array(adresse(1) & "; " & adresse(2) & "; " & _
adresse(3) & "; " & adresse(4) & "; " & adresse(5) & "; " & adresse(6), adresse(7), adresse(8), adresse(9), adresse(10))
'-------adresse du répertoire ou sera enregistré le fichier
AdresseRépertoire = ActiveWorkbook.Path
'---------------------copie de la feuille à envoyer
Application.DisplayAlerts = False
Sheets("Feuil2").Copy
'---------------------Nom du fichier à envoyer
ActiveWorkbook.SaveAs AdresseRépertoire & "\" & "Class.xls" ' ou adresse si le nom est dans une cellule Range("E2").Value & ".xls"
ActiveWindow.Close
'---------------------Envoi par mail
Sheets("Feuil1").Select
Range("H1").Select
'---------------------contrôle la validité ou la présence d'adresse mail en H1
If [H1] Like "*@*" Then
'---------------------Le mail est envoyé que si y a des adresses feuille 1 en H1
Do While Not IsEmpty(ActiveCell)
Dim msg As MailItem
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = Range("H1").Value 'Adresse de la cellule contenant la liste des adesses mails
'--------------------Saisir le sujet de l'envoi
msg.Subject = "Candidature spontanée - Ingénieur " ' ou saisir le sujet dans une cellule ex. Range("H2").Value
'---------------------saisie du message
msg.Body = "Bonjour" & Chr(13) & Chr(13) & "Body " & Chr(13) & Chr(13) & "line" & Chr(13) & Chr(13) & "Cordialement," & Chr(13) & "bengreen"
'---------------------ou saisir le message dans des cellules
'msg.Body = Range("E5").Value & Chr(13) & Chr(13) & Range("E8").Value & Chr(13) & Chr(13)& Range("E10").Value
'---------------------ou saisir le message dans des cellules
'---------------------Adresse de la pièce jointe
msg.Attachments.Add Source:="C:\Users\bengreen\Desktop\file.pdf" ' ou adresse si le nom est dans une cellule Range("E2").Value & ".xls"
msg.Send
'---------------------effacement de la liste d'envoi
[H1].ClearContents
Loop
Else
MsgBox "Aucune adresse valide sélectionnée"
End If
Application.ScreenUpdating = True
End Sub

1 réponse

Messages postés
12594
Date d'inscription
mardi 24 mai 2011
Statut
Contributeur
Dernière intervention
12 juin 2018
2 088
Sinon vous faite un publipostage avec Word. Vu que c'est fait pour ça.
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 86932 internautes nous ont dit merci ce mois-ci

bengreen
Messages postés
4
Date d'inscription
jeudi 5 décembre 2013
Statut
Membre
Dernière intervention
5 décembre 2013

Je ne sais pas qu'est-ce que c'est. Mais je vais voir sur internet et vous tenir au courant du résultat. Merci de votre réponse
bengreen
Messages postés
4
Date d'inscription
jeudi 5 décembre 2013
Statut
Membre
Dernière intervention
5 décembre 2013

J'ai bien trouvé comment faire mais il me reste le problème de la pièce jointe. Je pense que le publipostage ne prévoit pas de pièce jointe.
Bruce Willix
Messages postés
12594
Date d'inscription
mardi 24 mai 2011
Statut
Contributeur
Dernière intervention
12 juin 2018
2 088
Déso, je n'avais pas saisi le truc de la PJ. Tu as une solution ici
bengreen
Messages postés
4
Date d'inscription
jeudi 5 décembre 2013
Statut
Membre
Dernière intervention
5 décembre 2013

Je vous remercie infiniment. ça marche!!!!
Bruce Willix
Messages postés
12594
Date d'inscription
mardi 24 mai 2011
Statut
Contributeur
Dernière intervention
12 juin 2018
2 088
Mais de rien, avec plaisir ^^