XL 2016 From Excel to Outlook - Déclenchement sur la date et arrêt de la macro

[KASMINATOR]

Bonjour,
J'ai réussi à structurer mon fichier et finaliser ma macro "creer rappels AR"
J'ai un problème sur la macro "Nouvelle commande".
L'idée est la suivante : J'ai saisi une commande produit et je veux relancer par mail pour la commande suivante.
La macro devra alors :
1- Vérifier si date de la prochaine commande est inférieur à la date du jour pour déclencher une commande
2- Ne s'appliquer que si les 2 conditions sont réunies
Date saisie dans VT saisie (colonne A)
Nouvelle commande le = vide (colonne B)

Le problème que je rencontre c'est que la macro s'active pour toutes les lignes et les informations correspondantes ne fonctionnes pas.

Bonus : Est-il possible de programmer le destinataire en fonction d'une liste déroulante automatisée ?

Merci de l'aide que vous pourrez m'apporter.

Sub envoimail()

Dim messagerie As Object
Dim email As Object
Dim cel As Range
Dim delai As Integer

Set messagerie = CreateObject("Outlook.Application")

delai = 5 'jours

For Each cel In Range("A4:A" & Range("A4").End(xlDown).Row)
If cel.Offset(, 15).Value - Now < delai Then

Set email = messagerie.CreateItem(0)

With email
.To = cel.Offset(, 10).Value
.Subject = "BENEFIT - Merci de prévoir une nouvelle commande d'Isatuximab"
.Body = "Bonjour, XXXXXXXXXXXX " & cel.Offset(, 4) & " arrive à échéance." & vbCrLf & "Merci de faire le nécessaire avant la date d’echeance." & vbCrLf & "Cordialement"

.ReadReceiptRequested = True
.Display ' à remplacer par .send si ok
End With

Set email = Nothing

End If
Next cel

Set messagerie = Nothing

End Sub

 

[fanch55]

Bonjour,
Une table structurée n'a pas besoin de lignes "vides".
Quand vous insérez une nouvelle ligne dans la table, celle-ci reporte automatiquement les formules existantes.
Soyez plus rigoureux dans ces formules afin qu'elles ne produisent pas de valeurs indésirables ( telles qu'une date par défaut pour l'année 1900 )
Dans le classeur joint, je les ai modifiées et corrigé la macro envoimail() .
Nota: il n'y a pas d'adresse mail dans le tableau ?

 

[KASMINATOR]

Merci beaucoup de votre aide.
Merci pour l'aide à la structuration du fichier. Il est vraiment que la donnée se répétait... désolé
Je ne savais pas s'il était possible d'attribuer une adresse e-mail différente en fonction d'une valeur précise d'une cellule. Dans mon cas si le numéro de centre (colonne C) est différent alors le destinataire de l'e-mail sera différent.

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @KASMINATOR , bonjour @fanch55
Je ne réponds jamais assez vite ...

• J'ai repris la solution de Fanch55 en ajoutant une feuille Tables qui contient la liste des centres (avec ville, contact et eMail) et la liste des produits et j'ai nommé ces tableaux (tbSuivi dans l'onglet suivi, tbCentres et tbProduits dans l'onglet Tables).
• J'ai mis des validations de données dans le tableau tbSuivi
• J'ai adapté la macro de Fanch55 en conséquence :

Sub envoimail()
     Dim I           As Long
     Dim LgnCentre   As Long
     Dim Messagerie  As Object
     Dim Delai       As Date
     Set Messagerie = CreateObject("Outlook.Application")
 
     Delai = DateAdd("d", 5, Date)
     For I = 1 To [tbSuivi].Rows.Count
         'Si Nouvelle commande non renseignée, Prochaine commande renseignée et inférieure à Délai :
         If Not IsDate([tbSuivi[Nouvelle commande le]].Rows(I)) And IsDate([tbSuivi[Prochaine commande le]].Rows(I)) And [tbSuivi[Prochaine commande le]].Rows(I) < Delai Then
             With Messagerie.CreateItem(0)
                 'N° de ligne du centre dans le tableau tbCentres :
                 LgnCentre = WorksheetFunction.Match([tbSuivi[N° Centre]].Rows(I), [tbCentres[N° Centre]], 0)
                 'Destinataire lu dans le tableau tbCentres :
                 .To =[tbcentres].Rows(LgnCentre)
                 'Produit lu dans le tableau tbSuivi :
                 .Subject = "BENEFIT - Merci de prévoir une nouvelle commande du produit : " & [tbsuivi[Produit]].Rows(I)
              'Nom du contact lu dans le tableau tbCentres :
                 .Body = "Bonjour, " & [tbcentres[Contact]].Rows(LgnCentre) & vbLf & vbLf
                'N° de commande et date d'échéance lus dans le tableau tbSuivi :
                 .Body = .Body & "La commande " & Format([tbsuivi[[N° de commande]]].Rows(I), "000") & " arrive à échéance le " & [tbSuivi[Prochaine commande le]].Rows(I) & vbLf
                 .Body = .Body & "Merci de faire le nécessaire avant cette date." & vbLf
                 .Body = .Body & vbLf & "Cordialement"
                 .ReadReceiptRequested = True
                 .Display ' à remplacer par .send si ok
             End With
         End If
     Next
 
     Set Messagerie = Nothing
End Sub

Peut-être faut-il remplir la cellule "Rappel Outlook créé" avec "Oui" lorsqu'on envoie le mail et tester si cette valeur est à "Oui" avant de faire la relance il faudrait alors rajouter une condition au test initial :

...
'Si Rappel Outlook créé <>"Oui", Nouvelle commande non renseignée, Prochaine commande renseignée et inférieure à Délai :
If [tbSuivi[Rappel Outlook créé]].Rows(I) <> "Oui" and Not IsDate([tbSuivi[Nouvelle commande le]].Rows(I)) And IsDate([tbSuivi[Prochaine commande le]].Rows(I)) And [tbSuivi[Prochaine commande le]].Rows(I) < Delai Then
...

et après l'envoi :

 ...
       .ReadReceiptRequested = True
        .Send
    End With
    [tbSuivi[Rappel Outlook créé]].Rows(I) = "Oui"
End If
...

Amicalement
Alain[/CODE][/CODE]