Boucle envoi mail individuel conditionnel avec pièce jointe

Bonsoir à tous,

Je viens de créer un code pour envoyer un mail personnalisé depuis excel avec pièce jointe prise depuis un lien hypertexte basé sur mon fichier excel. Tout fonctionne très bien. A présent, je souhaiterais mettre un place une boucle pour qu'il m'envoie des mail depuis un tableau, je m'explique...

J'ai un tableau excel qui reprend:

colonne A : Titre

colonne B : Prénom

colonne C : Nom

colonne D : e-mail

colonne E : lien hypertexte

Mon souhait est le suivant, si la case lien hypertexte est non vide, envoyer le mail avec les info de la ligne en question, puis passer à la ligne suivante... et ainsi de suite.

Pour info, voici le code que j'ai crée pour l'envoi du mail standard :

Sub Envoyer_Mail_Outlook()

Dim ObjOutlook As New Outlook.Application

Dim oBjMail

Dim Nom_Fichier As String

Set ObjOutlook = New Outlook.Application

Set oBjMail = ObjOutlook.CreateItem(olMailItem)

Nom_Fichier = ActiveSheet.Range("C8").Value

With oBjMail

.To = ActiveSheet.Range("C7").Value ' le destinataire

.Subject = ActiveSheet.Range("B11").Value ' l'objet du mail

.Body = ActiveSheet.Range("B12").Value & Chr(13) & Chr(13) & ActiveSheet.Range("B13").Value & Chr(13) & ActiveSheet.Range("B14").Value 'le corps du mail ..son contenu

.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier

.Send

End With

Set oBjMail = Nothing

Set ObjOutlook = Nothing

End Sub

Il y a t-il des inspirés sur ce sujet?

Par avance merci!

adapte les valeurs d'offset comme nécessaire :

Sub Envoyer_Mail_Outlook()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String
Dim cel As String

Set ObjOutlook = New Outlook.Application

For Each cel In Range("E2:E" & Range("E" & Application.Rows.Count).End(xlUp).Row)
If cel.Value <> "" Then
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

Nom_Fichier = cel.Offset(-4, 0).Value

With oBjMail
.To = cel.Offset(-1, 0).Value ' le destinataire
.Subject = cel.Offset(-1, 0).Value ' l'objet du mail
.Body = cel.Offset(-4, 0).Value & Chr(13) & Chr(13) & cel.Offset(-3, 0).Value & Chr(13) & cel.Offset(-2, 0).Value 'le corps du mail ..son contenu
.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
.Send
End With
Set oBjMail = Nothing

End If
Next cel

Set ObjOutlook = Nothing
End Sub

Merci beaucoup Steelson!

Ce code me parait excellent, je viens d'essayer, et Excel m'ouvre le débogage et me surligne "Cel", il semble ne pas apprécier, j'ai essayé de remplacer par "Cell", "Cels" et "Cells" mais rien n'y fait... Au idée du pourquoi peut-être?

Par avance merci!!!

erreur de ma part :

Dim cel As Range

et non :

Dim cel As String

Je n'ai pas testé car je n'ai pas outlook à la maison !

C'est officiel... Tu viens de devenir mon nouveau MEILLEUR AMI!!!

Ca marche du tonnerre! Un grand grand merci pour tout!

Bonne soirée