Parcourir dates d'écheance et envoyer un mail

Résolu
kaskssou
Messages postés
37
Date d'inscription
lundi 30 juillet 2018
Statut
Membre
Dernière intervention
18 juillet 2019
- Modifié le 30 juil. 2018 à 15:17
kaskssou
Messages postés
37
Date d'inscription
lundi 30 juillet 2018
Statut
Membre
Dernière intervention
18 juillet 2019
- 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

5 réponses

Patrice33740
Messages postés
8549
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
7 mai 2022
21
Modifié le 30 juil. 2018 à 16:35
Bonjour,

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

Cordialement
Patrice
1
kaskssou
Messages postés
37
Date d'inscription
lundi 30 juillet 2018
Statut
Membre
Dernière intervention
18 juillet 2019

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 :

0
kaskssou
Messages postés
37
Date d'inscription
lundi 30 juillet 2018
Statut
Membre
Dernière intervention
18 juillet 2019

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 :
0
Patrice33740
Messages postés
8549
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
7 mai 2022
21
Modifié le 30 juil. 2018 à 18:14
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
1
kaskssou
Messages postés
37
Date d'inscription
lundi 30 juillet 2018
Statut
Membre
Dernière intervention
18 juillet 2019

31 juil. 2018 à 08:48
Bonjour Patrice, J'ai essayé de vérifier les valeurs et les déclarations des valeurs mais en vain ! j'ai toujours le problème d'incompatibilité qui s'affiche à la fin.
0
Patrice33740
Messages postés
8549
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
7 mai 2022
21
31 juil. 2018 à 10:58
Ton code est-il bien dans un module standard ?
VBA devrais indiquer sur quelle ligne se situe le problème
0
kaskssou
Messages postés
37
Date d'inscription
lundi 30 juillet 2018
Statut
Membre
Dernière intervention
18 juillet 2019

31 juil. 2018 à 13:41
Bonjour Patrice ! Alors oui j'ai mon code sur un module standard et la ligne où ça bloque est la suivante : Var = Feuil4.Cells(NoLig, NoCol)

Mon code après un léger changement est comme suite :
Sub Alerte()
Dim OutApp
Dim OutMail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Dim duree As Double
Dim NoCol As Integer
Dim NoLig As Long, Var As Variant
NoCol = 7 'lecture de la colonne 1
Var = Feuil4.Cells(NoLig, NoCol)
duree = Now - Var
If duree > 0 Then
For NoLig = 6 To Split(Feuil4.UsedRange.Address, "$")(4)
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
Next
End If
On Error Resume Next
On Error GoTo 0
End Sub
0
kaskssou
Messages postés
37
Date d'inscription
lundi 30 juillet 2018
Statut
Membre
Dernière intervention
18 juillet 2019

31 juil. 2018 à 13:46
Re bonjour patrice !

Remarque le type d'erreur n'est plus le même ! j'ai maintenant l'erreur suivante :

sur la ligne : Var = Feuil4.Cells(NoLig, NoCol)
0
Patrice33740
Messages postés
8549
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
7 mai 2022
21
31 juil. 2018 à 17:04
Normal, NoLig = 0 (tu ne l'a pas affecté d'une valeur)
0
Patrice33740
Messages postés
8549
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
7 mai 2022
21
3 août 2018 à 12:02
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."
1
kaskssou
Messages postés
37
Date d'inscription
lundi 30 juillet 2018
Statut
Membre
Dernière intervention
18 juillet 2019

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)
0
Patrice33740
Messages postés
8549
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
7 mai 2022
21
Modifié le 3 août 2018 à 14:04
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
1
kaskssou
Messages postés
37
Date d'inscription
lundi 30 juillet 2018
Statut
Membre
Dernière intervention
18 juillet 2019

3 août 2018 à 14:35
Bonjour Patrice,

Merci énormément pour ce code complétement modifié ! a priori ça à l'air de fonctionner ! Sauf une remarque que je viens de faire ... Si le code renvois un premier mail pour la première case il ne fait pas autant pour le reste ! C.-à-d. si j'ai deux dates expirées il prend la première date rencontrée par la boucle il envoi le mail et il s'arrête !! Est ce qu'on peut concaténer l'ensemble des éléments expirée avant d'envoyer le mail ? ou Bien d'envoyer un mail pour chaque date ?

Bien cordialement,
0
Patrice33740
Messages postés
8549
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
7 mai 2022
21
Modifié le 3 août 2018 à 14:45
« j'ai deux dates expirées il prend la première date rencontrée par la boucle il envoi le mail et il s'arrête !! » Comment s'arrête-t'il ? ll n'a pas de raison de s'arrêter ...

Il faut peut-être ajouter une ligne avec DoEvents après le .Send
0
kaskssou
Messages postés
37
Date d'inscription
lundi 30 juillet 2018
Statut
Membre
Dernière intervention
18 juillet 2019

3 août 2018 à 14:46
Je ne reçois qu'une seule date sur mon mail ! j'ai fait le teste à plusieurs reprises est à chaque fois je n'ai que la première date expirée sur mon mail ! (aucune notifications pour les tâches juste après)
0
Patrice33740
Messages postés
8549
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
7 mai 2022
21
Modifié le 3 août 2018 à 15:03
Effectivement, comme je n'utilise pas Outlook je ne peux pas tester, mais j'ai trouvé sur le forum : il faut rénitialiser OutMail à chaque mail :
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 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
        Set OutMail = OutApp.CreateItem(0)
        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
        Set OutMail = Nothing
      End If
    End If
  Next noL
End Sub
0
kaskssou
Messages postés
37
Date d'inscription
lundi 30 juillet 2018
Statut
Membre
Dernière intervention
18 juillet 2019

3 août 2018 à 15:08
Bingo ! Le mystère est résolu !
ça marche cette fois ! Le code a parcouru toutes les cases du fichier ! Merci bcp :D :D :) ! Il me reste un seul dernier truc c'est de fermer le fichier une fois le code fini de vérifier les cases de la feuil !

J'ai trouvé ce code :
Sub Macro2()
'''''instructions
   ActiveWorkbook.Save ' enregistre
    ActiveWorkbook.Close False 'ferme
End Sub


Mais ça n'a pas l'air de fonctionné
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Patrice33740
Messages postés
8549
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
7 mai 2022
21
14 août 2018 à 00:33
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
0
kaskssou
Messages postés
37
Date d'inscription
lundi 30 juillet 2018
Statut
Membre
Dernière intervention
18 juillet 2019

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.
0
kaskssou
Messages postés
37
Date d'inscription
lundi 30 juillet 2018
Statut
Membre
Dernière intervention
18 juillet 2019

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 ? :/
0
kaskssou
Messages postés
37
Date d'inscription
lundi 30 juillet 2018
Statut
Membre
Dernière intervention
18 juillet 2019

Modifié le 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.
0