Envoyer des mails automatiquement aux personnes concernées

Bonjour

J'ai un fichier excel qui recense des évaluations de poste.

De la colonne A à G, se trouve des informations sur le poste concerné et également la personne à qui envoyé le mail (colonne C). Et en colonne L, il s'agit de la validité de la cotation (OK ou NOK).

Et l'objectif est que pour les cellules NOK, il faudrait envoyer un mail à la personne (nom qui se trouve sur la même ligne) pour lui rappeler de faire l'évaluation.

Il faudrait également que je sache si le mail a été envoyé ou non pour ne part les harceler.

Bonjour,

n'oublier pas d'activer la référence à Microsoft Outlook xx Object Library

Private Sub Testmailauto()
Dim i As Integer, LastRw As Integer, sh1

Set sh1 = Sheets("Fiche Evaluation")
LastRw = sh1.Cells(Rows.Count, 1).End(xlUp).Row

For i = 10 To LastRw
  If sh1.Range("L" & i).Value = "NOK" Then
    sh1.Range("K" & i) = sh1.Range("K" & i) + 1
    sh1.Range("L" & i) = "OK"
    envoimail1 sh1.Range("C" & i), sh1.Range("E" & i)
  End If
Next i

Set sh1 = Nothing
End Sub

Sub envoimail1(Mailto, poste)
Dim appOutlook As Outlook.Application
Dim oMail As Outlook.MailItem
   Set appOutlook = CreateObject("Outlook.Application")
   If Not (appOutlook Is Nothing) Then
      Set oMail = appOutlook.CreateItem(olMailItem)
        With oMail
         .To = Mailto
         .Subject = "Rappel cotation FSSE " & Mailto
         .Body = "Bonjour, Merci de mettre à jour votre cotation FSSE " & poste
         .Display
  '       .Send
        End With
      Set oMail = Nothing
      Set appOutlook = Nothing
   End If
End Sub

Bonjour et Merci sabV.

Ton code fonctionne très bien.

Private Sub Testmailauto()
Dim i As Integer, LastRw As Integer, sh1

Set sh1 = Sheets("Fiche Evaluation")
LastRw = sh1.Cells(Rows.Count, 1).End(xlUp).Row

For i = 10 To LastRw
  If sh1.Range("L" & i).Value = "NOK" Then
    sh1.Range("K" & i) = sh1.Range("K" & i) + 1
   sh1.Range("J" & i) = "FAITE"
  envoimail1 sh1.Range("C" & i), sh1.Range("E" & i)
  End If
Next i

Set sh1 = Nothing
End Sub

Sub envoimail1(Mailto, poste)
Dim appOutlook As Outlook.Application
Dim oMail As Outlook.MailItem
   Set appOutlook = CreateObject("Outlook.Application")
   If Not (appOutlook Is Nothing) Then
      Set oMail = appOutlook.CreateItem(olMailItem)
        With oMail
         .To = Mailto
         .Subject = "Rappel cotation FSSE " & Mailto
         .Body = "Bonjour, Merci de mettre à jour votre cotation FSSE ST/OP N°" & poste
         .Display
  '       .Send
        End With
      Set oMail = Nothing
      Set appOutlook = Nothing
   End If
End Sub

J'ai juste fait une modification afin que lorsque le mail est envoyé la colonne L (Validité FSSE) reste NOK car il n'a pas encore fait la mise à jour de la cotation.

J'ai également rajouté dans la colonne J ==> l'état des relances (FAITE).

Pour info pour que les cellules de la colonne L affiche OK il faut que la date de cotation colonne H soit inf à 1an par rapport à la date du jour (=aujourdhui). si c'est pas le cas la cellule affiche NOK.

Est-il possible par contre de remettre à zero les colonnes J et K lorsque le poste a été réévalué (autrement dit lorsqu'il passe de NOK à OK) ?

Merci

Bonjour,

Voilà pour la remise à zero lorsque la colonne L = "OK"

Private Sub Testmailauto2()
Dim i As Integer, LastRw As Integer, sh1

Set sh1 = Sheets("Fiche Evaluation")
LastRw = sh1.Cells(Rows.Count, 1).End(xlUp).Row

For i = 10 To LastRw
  If sh1.Range("L" & i).Value = "NOK" Then
    sh1.Range("K" & i) = sh1.Range("K" & i) + 1
    sh1.Range("J" & i) = "FAITE"
    envoimail1 sh1.Range("C" & i), sh1.Range("E" & i)
  Else
    sh1.Range("K" & i).ClearContents
    sh1.Range("J" & i).ClearContents
  End If
Next i

Set sh1 = Nothing
End Sub

Merci pour vos réponses ça fonctionne très bien.

Autre problématique, j'ai un tableau au deux colonnes qui s'actualise automatiquement. J'ai besoin d'avoir un suivi de ces chiffres sur la durée.

Donc autrement dit lorsque une valeur change, il faudrait que la valeur se reporte sur le graphique.

Je vous joint mon fichier excel.

Par avance merci