Macro envoi de mail sous condition

Bonjour à tous,

Je souhaite réaliser ma première macro, et malgré mes heures de recherche je n'arrive pas à obtenir le résultat escompté.

J'ai un tableau excel avec des actions à réaliser (colonne D), un délai correspondant (colonne L) , l'adresse mail du chargé d'action (colonne J).

J'ai déjà fais une fonction SI dans la colonne R et il y apparaît donc ENVOIMAIL lorsqu'un mail de rappel doit être envoyé au chargé d'action.

Je voudrais que quand apparaît ENVOIMAIL dans la colonne R, un mail soit envoyé au chargé d'action avec la description de l'action en retard.

J'ai bidouillé ce code:

Sub envoimail()

Dim action As String

Dim adresse As String

action = Range("D2")

adresse = Range("J2")

Dim ObjOutlook As New outlook.Application

Dim oBjMail

Set ObjOutlook = New outlook.Application

Set oBjMail = ObjOutlook.CreateItem(olMailItem)

'

With oBjMail

.To = adresse ' le destinataire

.Subject = action

.body = "Bonjour," & vbCrLf & vbCrLf _

& "Le délai pour cette action d'amélioration est dépassé." & vbCrLf _

& "En tant que pilote de l'action, merci de la relancer et d'informer le service qualité de son état d'avancement" & vbCrLf & vbCrLf & vbCrLf _

& "Cordialement " & vbCrLf _

.Send

End With

ObjOutlook.Quit

Set oBjMail = Nothing

Set ObjOutlook = Nothing

End Sub

Et il fonctionne , mais j'ai deux problèmes :

-En laissant action = D2 et adresse = J2 ça fonctionne bien mais je n'arrive pas à faire marcher la macro afin qu'elle balaye toutes les lignes.

- Je n'arrive pas à intégrer la condition, dois-je la mettre comme une première macro avant la macro envoimail ou la définir comme "function" ?

Merci beaucoup à tous ceux qui se pencheront sur mon problème.

bonjour

tu peux peut-etre t'inspirer de ce code pour faire ta boucle

Public Sub EnvoiAutomatiqueMail()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim i As byte
'init des messages
For i = 2 To ThisWorkbook.Worksheets("Param").Range("D" & Rows.Count).End(xlUp).Row ' on passe en revue toutes les lignes de la colonne A
   Set OutlookApp = CreateObject("outlook.application")
    Set OutlookMail = OutlookApp.createitem(0)
        With OutlookMail
        .Subject = ThisWorkbook.Worksheets("Param").Range("Q4").Value  'sujet du mail
       .To = ThisWorkbook.Worksheets("Param").Range("D" & i).Value 'adresse mail destinataire
       .cc = ThisWorkbook.Worksheets("Param").Range("L3").Value
        '.body = message 'corps du message
       .Display
        '.send 'on envoie le mail créé
       End With
Next i 'on passe au mail suivant
End Sub

tirer de ce post :

https://forum.excel-pratique.com/excel/boucle-pour-envoyer-mail-t66477.html?hilit=mail

fred

Bonjour Fred2406 et merci beaucoup, ça marche !!

Je n'ai plus qu'à intégrer ma condition, je vais essayer d'y travailler.

Pour l'instant mon code est le suivant , pour ceux que ça peux intéresser :

Sub envoimail()
Dim action As String
Dim adresse As String

action = Range("D2")
adresse = Range("J2")

Dim ObjOutlook As New outlook.Application
Dim oBjMail
Dim i As Byte
For i = 2 To ThisWorkbook.Worksheets("Tableau des actions").Range("D" & Rows.Count).End(xlUp).Row

    Set ObjOutlook = New outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)

     With oBjMail
    .To = adresse ' le destinataire
    .Subject = action
    .body = "Bonjour," & vbCrLf & vbCrLf _
       & "Le délai pour cette action d'amélioration est dépassé :" & vbCrLf & vbCrLf _
       & ThisWorkbook.Worksheets("Tableau des actions").Range("D" & i).Value & vbCrLf & vbCrLf _
       & "En tant que pilote de l'action, merci de la relancer et d'informer le service qualité de son état d'avancement" & vbCrLf & vbCrLf & vbCrLf _
       & "Cordialement " & vbCrLf _

         .Send

       End With
       Next i

    ObjOutlook.Quit
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing

End Sub

Rebonjour,

En fait je me suis emballée j'ai réussi à passer à l'action suivante à chaque fois , avec la même adresse mail , mais je n'arrive pas à ajouter le changement d'adresse .

Je pensais qu'en prenant une autre lettre que "i" ça marchait , mais visiblement ce n'est pas comme ça qu'il faut faire :

Dim i As Byte
Dim j As Byte

For i = 2 To ThisWorkbook.Worksheets("Tableau des actions").Range("D" & Rows.Count).End(xlUp).Row
For j = 2 To ThisWorkbook.Worksheets("Tableau des actions").Range("J" & Rows.Count).End(xlUp).Row

    Set ObjOutlook = New outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)

     With oBjMail
    .To = ThisWorkbook.Worksheets("Tableau des actions").Range("J" & j).Value
    .Subject = action
    .body = "Bonjour," & vbCrLf & vbCrLf _
       & "Le délai pour cette action d'amélioration est dépassé :" & vbCrLf & vbCrLf _
       & ThisWorkbook.Worksheets("Tableau des actions").Range("D" & i).Value & vbCrLf & vbCrLf _
       & "En tant que pilote de l'action, merci de la relancer et d'informer le service qualité de son état d'avancement" & vbCrLf & vbCrLf & vbCrLf _
       & "Cordialement " & vbCrLf _

         .Send

       End With
       Next i, j

Quelqu'un pourrait 'il m'indiquer comment rajouter mon changement d'adresse ?

Merci d'avance !

C'est encore moi.

Bon tant bien que mal j'ai voulu intégrer tous les éléments de mon code, du coup il ne se passe plus rien alors qu'initialement le mail était bien envoyé.

Il n'y a pas de message d'erreur , mais je pense que la condition n'est pas formulée correctement :

 Sub envoimail()
Dim ObjOutlook As New outlook.Application
Dim oBjMail
Dim k, j, i As Byte

For k = 2 To ThisWorkbook.Worksheets("Tableau des actions").Range("R" & Rows.Count).End(xlUp).Row
If ThisWorkbook.Worksheets("Tableau des actions").Range("R" & k).Value = "ENVOIMAIL" Then
Set ObjOutlook = New outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)
Else: Exit Sub
End If
Next k

For j = 2 To ThisWorkbook.Worksheets("Tableau des actions").Range("J" & Rows.Count).End(xlUp).Row
For i = 2 To ThisWorkbook.Worksheets("Tableau des actions").Range("D" & Rows.Count).End(xlUp).Row

     With oBjMail
    .To = ThisWorkbook.Worksheets("Tableau des actions").Range("J" & j).Value
   .Subject = "Suivi des actions d'amélioration"
    .body = "Bonjour," & vbCrLf & vbCrLf _
       & "Le délai pour cette action d'amélioration est dépassé :" & vbCrLf & vbCrLf _
       & ThisWorkbook.Worksheets("Tableau des actions").Range("D" & i).Value & vbCrLf & vbCrLf _
       & "En tant que pilote de l'action, merci de la relancer et d'informer le service qualité de son état d'avancement" & vbCrLf & vbCrLf & vbCrLf _
       & "Cordialement " & vbCrLf _

         .Send

End With
Next i, j

    ObjOutlook.Quit
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing

End Sub

Si quelqu'un peut y jeter un coup d'oeil et m'indiquer comment finaliser ? Merci beaucoup.

bonjour

un essai :

For i = 2 To ThisWorkbook.Worksheets("Tableau des actions").Range("J" & Rows.Count).End(xlUp).Row
If ThisWorkbook.Worksheets("Tableau des actions").Range("R" & i).Value = "ENVOIMAIL" Then
    Set ObjOutlook = New outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)

     With oBjMail
    .To = ThisWorkbook.Worksheets("Tableau des actions").Range("J" & i).Value
    .Subject = Action
    .body = "Bonjour," & vbCrLf & vbCrLf _
       & "Le délai pour cette action d'amélioration est dépassé :" & vbCrLf & vbCrLf _
       & ThisWorkbook.Worksheets("Tableau des actions").Range("D" & i).Value & vbCrLf & vbCrLf _
       & "En tant que pilote de l'action, merci de la relancer et d'informer le service qualité de son état d'avancement" & vbCrLf & vbCrLf & vbCrLf _
       & "Cordialement " & vbCrLf _

         .Send

    End With
    End If
Next

fred

Bonjour ,

ça marche nickel !!! MERCI BEAUCOUP Fred2406.

Par contre je serais intéressée de comprendre comment , mais en tout cas merci encore.