Parcourir dates d'écheance et envoyer un mail [Résolu]

kaskssou 29 Messages postés lundi 30 juillet 2018Date d'inscription 14 août 2018 Dernière intervention - 30 juil. 2018 à 15:16 - Dernière réponse : kaskssou 29 Messages postés lundi 30 juillet 2018Date d'inscription 14 août 2018 Dernière intervention
- 14 août 2018 à 09:37
Bonjour les amis,

Je suis un peu nouveau sur excel et le travail avec macros ! Grace à ce forum j'ai pu collecté les informations pour faire un petit code rapide.

Objectif : Parcourir une colonnes contenant les dates d'échéances avec application de la condition "si, date d'aujourd'hui - date de la case > 0, alors envoyer mail d'alerte".

Mon problème c'est que je n'ai pas réussi à vérifier la condition pour les cases de ma colonne ( la 7eme colonne G ).

Le code que j'ai jusqu'à présent est le suivant (C'est très modeste mais c'est mon premier code VBA) ! Pourriez vous m'aider ou me donner des pistes d'améliorations ? Merci d'avance.

Sub Alerte()

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

Dim duree As Long
Dim Lig_Deb As Integer 'ligne de début, de fin
Dim NoCol As Integer
Dim NoLig As Long, Var As Variant

Lig_Deb = 6

NoCol = 7 'lecture de la colonne 1
For NoLig = 1 To Split(Feuil4.UsedRange.Address, "$")(4)
Var = Feuil4.Cells(NoLig, NoCol)
duree = Now - NoLig
If duree > 0 Then
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Plan d'action - Révision nécessaire"
.HTMLBody = "Bonjour,<br><br>" & "Le plan d'action <B> </B>doit être révisée, pensez à changer les dates.<br><br>" & "Cordialement."
.Send
End With
End If
Next
On Error Resume Next
On Error GoTo 0

End Sub
Afficher la suite 

Votre réponse

44 réponses

Patrice33740 7319 Messages postés dimanche 13 juin 2010Date d'inscription 17 octobre 2018 Dernière intervention - Modifié par Patrice33740 le 30/07/2018 à 16:35
0
Merci
Bonjour,

Au lieu de :
duree = Now - NoLig 
faire :
duree = Now - Var 
.

Cordialement
Patrice
kaskssou 29 Messages postés lundi 30 juillet 2018Date d'inscription 14 août 2018 Dernière intervention - 30 juil. 2018 à 16:40
Merci Patrice, Merci pour la réponse. J'ai essayé mais ça ne marche toujours pas ! J'ai le message d'erreur suivant :

kaskssou 29 Messages postés lundi 30 juillet 2018Date d'inscription 14 août 2018 Dernière intervention - 30 juil. 2018 à 17:12
Mon nouveau code est le suivant :
Sub Alerte()

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

Dim duree As Date
Dim Lig_Deb As Integer 'ligne de début, de fin
Dim NoCol As Integer
Dim NoLig As Long, Var As Variant

Lig_Deb = 6
NoCol = 7 'lecture de la colonne 1
For NoLig = 6 To Split(Feuil4.UsedRange.Address, "$")(4)
Var = Feuil4.Cells(NoLig, NoCol)
duree = Now - Var
If duree > 0 / 0 / 0 Then
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Plan d'action - Révision nécessaire"
.HTMLBody = "Bonjour,<br><br>" & "Le plan d'action <B> </B>doit être révisée, pensez à changer les dates.<br><br>" & "Cordialement."
.Send
End With
End If
Next
On Error Resume Next
On Error GoTo 0

End Sub



==> j'ai l'erreur suivante :
Commenter la réponse de Patrice33740
Patrice33740 7319 Messages postés dimanche 13 juin 2010Date d'inscription 17 octobre 2018 Dernière intervention - Modifié par Patrice33740 le 30/07/2018 à 18:14
0
Merci
Sur quelle ligne de code ???

Incompatibilité de type signifie que la valeur chargée n'est pas du type déclaré

Var devrais être de type Date mais Durée pas nécessairement, un Double serait préférable.

Sous forme de Date, zéro s'écrit #00:00:00#
Sous forme de Double, zéro s'écrit 0 ou 0#

Cordialement
Patrice
Patrice33740 7319 Messages postés dimanche 13 juin 2010Date d'inscription 17 octobre 2018 Dernière intervention - 2 août 2018 à 17:07
Re,

Soyons clairs, un mail est un courrier électronique qui ne comporte qu'un seul :
- Objet (Subject)
- Contenu (Body)
mais il peut comporter plusieurs destinataires directs (To), plusieurs destinataires d'une copie (CC) et plusieurs destinataires cachés (aux autres) d'une copie (BCC).
L'ensemble ne forme qu'un seul courrier.

Ce courrier est envoyé à l'adresse mail de chaque destinataire.
kaskssou 29 Messages postés lundi 30 juillet 2018Date d'inscription 14 août 2018 Dernière intervention - 3 août 2018 à 08:35
RE
Bonjour Patrice,

Je sais ma question concerne le destinateur (d'Où vient ce mail ?)

J'ai une question de plus ! Je cherche à envoyer dans le mail une case de la ligne qui contient la date expirée ! Est ce que t'as une idée à me proposer ?

Merci Patrice.

CDT;
Patrice33740 7319 Messages postés dimanche 13 juin 2010Date d'inscription 17 octobre 2018 Dernière intervention > kaskssou 29 Messages postés lundi 30 juillet 2018Date d'inscription 14 août 2018 Dernière intervention - 3 août 2018 à 11:34
Tu trouveras plus de détails sur la manipulation des chaines de caractères ici :
Manipuler les chaînes de caractères en VB6 et VBA Excel
Patrice33740 7319 Messages postés dimanche 13 juin 2010Date d'inscription 17 octobre 2018 Dernière intervention - 3 août 2018 à 11:17
Bonjour,

Bien que destinateur ait fait son entrée dans le Larousse, l'académie lui préfère Expéditeur ou Envoyeur : c'est-à-dire toi ou plutôt ton adresse mail dans la boite de messagerie utilisée (en anglais le Sender).

Pour envoyer la date :
    .HTMLBody = "Bonjour,<br>" & _
                "<br>" & _
                "Le plan d'action <B>doit être révisé</B>, pensez à changer les dates.<br>" & _
                "Il a expiré le " & Var & ".<br>" & _
                "<br>" & _
                "Cordialement."


Cdlt
kaskssou 29 Messages postés lundi 30 juillet 2018Date d'inscription 14 août 2018 Dernière intervention - 3 août 2018 à 11:41
Bonjour,

Ce que je cherche c'est d'envoyer une autre case (la case sur la colonne A) et qui se trouve sur la même ligne de la case VAR avec date expirée ! (C'est ce que j'ai expliqué sur l'autre poste ! Je veux envoyer le contenu de la case "Existant" lorsque la case équivalente sur la colonne Échéance est en rouge "c.-à-d. date dépassée".

Merci Patrice pour ton aide.

Bien Cordialement

PS : "J'ai cru que c'est un sujet à part c'est pour cela que j'ai posé une nouvelle question"
Commenter la réponse de Patrice33740
Patrice33740 7319 Messages postés dimanche 13 juin 2010Date d'inscription 17 octobre 2018 Dernière intervention - 3 août 2018 à 12:02
0
Merci
Re,

La proposition reste identique, ajoutes une variable par exemple

Dim Var As Date
Dim Exi As Date
'....
  For NoLig = 6 to 200
    NoCol = 7 'lecture de la colonne G
    Var = Worksheets("Feuil4").Cells(NoLig, NoCol).Value
    NoCol = 24 'lecture de la colonne X
    Exi = Worksheets("Feuil4").Cells(NoLig, NoCol).Value
'....
    .HTMLBody = "Bonjour,<br>" & _
                "<br>" & _
                "Le plan d'action <B>doit être révisé</B>, pensez à changer les dates.<br>" & _
                "Il a expiré le " & Exi & ".<br>" & _
                "<br>" & _
                "Cordialement."
kaskssou 29 Messages postés lundi 30 juillet 2018Date d'inscription 14 août 2018 Dernière intervention - 3 août 2018 à 12:19
Re Bonjour,

Je crois que ça ne va pas être suffisant pour réaliser l'objectif de l'application !
Voila le code que j'ai jusqu'à maintenant (Des fois ça ne m'envois pas de message même si je rajoute une date expirée ! Une autre remarque sur la boucle For je modifie à chaque fois la ligne d'arrêt selon le nombre de ligne que j'ai (200, 119,....etc.) Y a t'il un moyen pour remplacer ce chiffre par une condition : Exemple Cellule vide alors arrêter)

Sub auto_open()
Dim OutApp
Dim OutMail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Dim duree As Date
Dim NoCol As Integer
Dim NoLig As Long, Var As Date
Dim Exi As Date
Dim LValue As Date
LValue = Aujourdhui
'............................
For NoLig = 6 To 119
NoCol = 7 'lecture de la colonne G
Var = Cells(NoLig, NoCol).Value
Exi = Cells(NoLig, NoCol).Value
duree = LValue - Var
If duree > 0 Then
'.............................;
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Plan d'action - Révision nécessaire"
.HTMLBody = "Bonjour,<br><br>" & "Le plan d'action <B> </B>doit être révisée, " & "Il a expiré le " & Exi & "pensez à changer les dates.<br><br>" & "Cordialement."
.Send
End With
End If
Next
On Error GoTo 0
End Sub

'Note : L'objectif est d'envoyer toutes les cellules de la colonne 1 qui ont une date < à Aujoudhui() sur la cellules parallèle dans la colonne G nommée (Echéance)
Commenter la réponse de Patrice33740
Patrice33740 7319 Messages postés dimanche 13 juin 2010Date d'inscription 17 octobre 2018 Dernière intervention - Modifié par Patrice33740 le 3/08/2018 à 14:04
0
Merci
Re,

Il faudrait savoir, tu changes en permanence tes explications !!!

Voici un code qui devrais convenir (éventuellement avec une adaptation), il teste la date d'expiration contenue dans la colonne G et envoie un mail chaque fois que celle-ci est dépassée. Il rappelle, dans l'objet et dans le corps du message, le nom correspondant dans la colonne A :
Dans le module Thisworkbook (il faut éviter d'y mettre un code qui n'a rien à voir avec l'ouverture elle même !) :
Private Sub Workbook_Open()
  Call EnvoiMailDeRappel
End Sub

Dans un module standard :
Sub EnvoiMailDeRappel()
Dim OutApp As Object        'Application Outlook
Dim OutMail As Object       'Mail Outlook
Dim wsh As Worksheet        'feuille contenant les données
Dim ech As Variant          'date d'échéance
Dim nom As Variant          'nom du plan
Dim noL As Long             'numèro de ligne
Dim drL As Long             'dernière ligne

  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)
  Set wsh = Worksheets("Feuil4")
  drL = wsh.Cells(wsh.Rows.Count, "A").End(xlUp).Row
  For noL = 6 To drL
    nom = wsh.Cells(noL, "A").Value
    ech = wsh.Cells(noL, "G").Value
    If IsDate(ech) Then
      If ech - Date < 0 Then
        With OutMail
          .To = ""
          .CC = ""
          .BCC = ""
          .Subject = "Plan d'action " & nom & " - Révision nécessaire"
          .HTMLBody = "Bonjour,<br>" & _
                      "<br>" & _
                      "Le plan d'action <B>" & nom & " a expiré le " & ech & "</B><br>" & _
                      "<br>" & _
                      "Il doit être révisé. Pensez à changer les dates.<br>" & _
                      "<br>" & _
                      "Cordialement."
          .Send
        End With
      End If
    End If
  Next noL
End Sub



Cordialement
Patrice
kaskssou 29 Messages postés lundi 30 juillet 2018Date d'inscription 14 août 2018 Dernière intervention - 6 août 2018 à 09:26
Bonjour Patrice,

Je te remercie pour ton aide ! Mon code fonctionne parfaitement.

Merciiii :D

Cordialement.
Patrice33740 7319 Messages postés dimanche 13 juin 2010Date d'inscription 17 octobre 2018 Dernière intervention - 7 août 2018 à 12:20
De rien, au plaisir de te relire sur le Forum

Cdlt
Patrice
kaskssou 29 Messages postés lundi 30 juillet 2018Date d'inscription 14 août 2018 Dernière intervention - 10 août 2018 à 11:30
Bonjour Patrice ! J'espère que t'es toujours là !!

J'ai rencontré un petit problème après l'application du code ! Et c'est que je reçois beaucoup de mail à la fois (vu que plusieurs tâches touchent leur fin en même temps). Je me trouve avec une boite Mail complétement inondée par les mails et donc ingérable ...

Est ce que je peux regrouper toutes les tâches hors délais en un seul mail ? C.-à-d. :parcourir les délais ==> par la boucle For : enregistrer les échéances expirées dans une variable ==> envoyer l'ensemble des dates enregistrées par mail !! Merci d'avance !

Rappel du code qu'on a :
Sub auto_open()
Dim OutApp As Object        'Application Outlook
Dim OutMail As Object       'Mail Outlook
Dim wsh As Worksheet        'feuille contenant les données
Dim ech As Variant          'date d'échéance
Dim sco As Variant          ' Score d'avancement
Dim nom As Variant          'nom du plan
Dim noL As Long             'numèro de ligne
Dim drL As Long             'dernière ligne
Dim SWOT As Variant         ' Lien avec la matrice SWOT


  Set OutApp = CreateObject("Outlook.Application")
  Set wsh = Worksheets("PA")
  drL = wsh.Cells(wsh.Rows.Count, "B").End(xlUp).Row + 4
  For noL = 6 To drL
    nom = wsh.Cells(noL, "C").Value
    SWOT = wsh.Cells(noL, "B").Value
    ech = wsh.Cells(noL, "H").Value
    sco = wsh.Cells(noL, "J").Value
    If IsDate(ech) Then
      If ech - Date < 0 Then
       If sco <> 100 Then
      Set OutMail = OutApp.CreateItem(0)
        With OutMail
          .To = ""
          .CC = ""
          .BCC = ""
          .Subject = "Plan d'action " & nom & " - Révision nécessaire"
          .HTMLBody = "Bonjour,<br>" & _
                      "<br>" & _
                      "La date d'échéance de l'action :<B>" & "</B><br>" & "<br>" & "<B>" & SWOT & "</B>==>" & _
                       nom & " a expiré le " & ech & "</B><br>" & _
                      "<br>" & _
                      "Il doit être révisé. Pensez à changer les dates.<br>" & _
                      "<br>" & "Cordialement."
          .Send
         End With
        End If
      End If
    End If
Next noL
End Sub

Cordialement
Patrice33740 7319 Messages postés dimanche 13 juin 2010Date d'inscription 17 octobre 2018 Dernière intervention - 10 août 2018 à 17:40
Bonjour,

Dans ton code, il manque le(s) destinataire(s),.
Est-ce que tu te les envoies ???
- Dans ce cas, il est possible de tout regrouper dans un seul mail. Il est aussi possible de le classer dans un certain ordre (par ech, par sco, par nom, par SWOT) ;
- Sinon, comment regrouper : par destinataire, par ech, par sco, par nom, par SWOT, ... et comment classer ?
kaskssou 29 Messages postés lundi 30 juillet 2018Date d'inscription 14 août 2018 Dernière intervention - 13 août 2018 à 16:54
Bonjour Patrice,

Désolé pour le retard (j'avais pris Une journée de repos :D)
Alors pour les mails oui je les envoies ça marche (je mentionne le destinataire et ça fonctionne) ! le regroupement que je souhaite faire est par destinataire et le classement pas SWOT !

En gros recevoir des bloques en fonction de SWOT.

Merci d'avance
Cordialement
Commenter la réponse de Patrice33740
Patrice33740 7319 Messages postés dimanche 13 juin 2010Date d'inscription 17 octobre 2018 Dernière intervention - 14 août 2018 à 00:33
0
Merci
Bonjour,

Essaies :
Sub EnvoiMailDeRappel()
Dim OutApp As Object        'Application Outlook
Dim OutMail As Object       'Mail Outlook
Dim d As Object             'Dictionaire des SWOT
Dim clé As Variant          'Clé du dictionaire
Dim wsh As Worksheet        'feuille contenant les données
Dim ech As Variant          'date d'échéance
Dim sco As Variant          'Score d'avancement
Dim SWOT As Variant         'Lien avec la matrice SWOT
Dim nom As Variant          'nom du plan
Dim noL As Long             'numèro de ligne
Dim drL As Long             'dernière ligne

  Set OutApp = CreateObject("Outlook.Application")
  Set d = CreateObject("Scripting.Dictionary")
  Set wsh = ThisWorkbook.Worksheets("PA")
  drL = wsh.Cells(wsh.Rows.Count, "B").End(xlUp).Row + 4 'Pourquoi + 4 ?????
  For noL = 6 To drL
    nom = wsh.Cells(noL, "C").Value
    SWOT = wsh.Cells(noL, "B").Value
    ech = wsh.Cells(noL, "H").Value
    sco = wsh.Cells(noL, "J").Value
    If IsDate(ech) Then
      If ech - Date < 0 Then
        If sco <> 100 Then
          If Not d.Exists(SWOT) Then
            d(SWOT) = "<B>" & SWOT & "==>" & nom & " a expiré le " & ech & "</B><br>"
          Else
            d(SWOT) = d(SWOT) & "<B>" & SWOT & "==>" & nom & " a expiré le " & ech & "</B><br>"
          End If
        End If
      End If
    End If
  Next noL
  For Each clé In d.Keys
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
      .To = ""
      .CC = ""
      .BCC = ""
      .Subject = "Plan d'action - Révision nécessaire"
      .HTMLBody = "Bonjour,<br>" & _
                  "<br>" & _
                  "La date d'échéance de : <br>" & _
                  d(clé) & _
                  "<br>" & _
                  clé & " doit être révisé. Pensez à changer les dates.<br>" & _
                  "<br>" & "Cordialement."
      .Send
    End With
  Next clé
End Sub
kaskssou 29 Messages postés lundi 30 juillet 2018Date d'inscription 14 août 2018 Dernière intervention - 14 août 2018 à 08:46
Bonjour Patrice,

Merci beaucoup pour ton code ! Je vais l'adapté un peu à mon classeur car j'ai changé les noms des variables et les pages (donc je l'essaye et si j'ai un problème je reviens vers toi cher ami)

Merci et bonne journée

Bien cordialement.
kaskssou 29 Messages postés lundi 30 juillet 2018Date d'inscription 14 août 2018 Dernière intervention - 14 août 2018 à 09:11
Une toute petite question toute bête !! J'ai un ".close" vers la fin de mon programme et la le fichier excel il s'ouvre, exécute le code, et se ferme. Je ne peux pas le maintenir ouvert pour modifier mon code !! Comment faire dans ce cas ? :/
kaskssou 29 Messages postés lundi 30 juillet 2018Date d'inscription 14 août 2018 Dernière intervention - 14 août 2018 à 09:37
C'est Bon... j'ai trouvé la solution : Il faut aller sur Fichier==> Ouvrir ==> Maintenir "Shift" sur le clavier et double-clique sur le fichier ! Et ça marche.
Commenter la réponse de Patrice33740

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.