XL 2016 MsgBox en fonction d'une date + envoi mail outlook

[D10]

Bonjour à tous,

Je viens encore une fois vous demander de l'aide en VBA.
Je souhaite créer un fichier simple qui se compose de la sorte:

6 colonnes, dont la 5éme qui contiendra des dates.
-Nom
-Prénom
-Sexe
-Adresse
-Date de mise à jour des données
-Nom du salarié qui s'est occupé de mettre à jour l'adresse de la personne en question.

Je souhaite créer une macro me donnant le nom et prénom des lignes qui n'ont pas été mises à jour depuis plus d'un an.

J'obtiendrais un message comme ceci: "Les données qui n'ont pas été mises à jour depuis plus d'un an sont:
-aaaa bbbb
-cccc dddd"

Je me doute que ça soit possible mais y'a t'il une solution simple ?

Merci d'avance,

Bonne journée!

 

[Hasco]

Bonjour,

Je me doute que ça soit possible mais y'a t'il une solution simple ?

Une Mise en forme conditionnelle, un filtrage avancé sur place ou autre feuille, requête power query etc...

Pour faut-il que les utilisateurs demandent prioritairement une macro? Très sale habitude (pourtant j'ai appris et pratique le vba depuis sa sortie avec office 97).

Une fois votre msgbox affiché, vous allez apprendre par coeur les noms, les noter sur un papier ?

Ah comment il s'appelait celui-là ? ...hum j'ai oublié.

Bonne cogitation

 

[D10]

Bonjour,
merci pour la réponse.
Alors si possible une nouvelle feuille dans lequel j'ai un résumé de tous les utilisateurs qui n'ont pas été mis à jour depuis plus d'un an

 

[Hasco]

Re,

Et nous sortons la feuille à partir du néant ? Serions-nous Dieu?

A plus

 

[Hasco]

Re,

Eh ben vous donnez pas beaucoup : 3 lignes dont une qui remplit la condition. Super les tests.

En pièce jointe une proposition par formule et Mise en forme conditionnelle. La différence avec la date est calculée sur la base de Mois.Decaler(Aujourdhui();-12) c'est à dire 12 mois avant aujourd'hui de date à date.

Votre tableau a été transformé en tableau structuré. Et un deuxième en Feuille 2 a été créé, prévu pour une dizaine de salariés. Aucune indication là-dessus non plus.

Bonne soirée

 

[D10]

cela va beaucoup m'aider, je vous remercie !
j'avais une dernière question mais je vais peut-être devoir créer un autre sujet.

 

[D10]

Bonsoir à tous,

Serait-il possible de créer une macro permettant d'envoyer un mail automatiquement à ceux qui n'ont pas mis à jour ma base de donnée ?

Par exemple, si l'on prend le fichier de Roblochon, "Titi" n'a pas mis à jour les données d'un salarié depuis plus d'un an, il faudrait alors lui envoyer un mail auto pour lui demander de mettre à jour les données de la personne dont l'identité se trouve en colonne A et B.

Faisable ?

 

[Hasco]

Bonjour,

Oui, c'est faisable!

Dans un autre fil de discussion. D'ailleurs le forum regorge de fils de discussion au sujet d'envois de mail suivant condition.

Bonnes recherches

 

[D10]

Bonjour à tous,

En cherchant sur le forum et ailleurs, j'ai trouvé et adapté une macro me permettant d'envoyer des mails à ceux qui n'ont pas mis à jour ma base de données. Tu trouveras le fichier en PJ.

J'ai un dernier problème.
Pour les personnes qui apparaissent deux fois (ou plus d'ailleurs) j'aimerais n'envoyer qu'un seul mail et non pas un par donnée non mise à jour.
Dans l'exemple du fichier, Titi n'a pas mis à jour les données de EEE FFF & KKK LLL. Lorsque tu lances la macro tu obtiendras deux mails à destination de la même personne (un pour alerter pour les données de EEE FFF et un autre pour KKK LLL).
J'aimerais donc envoyer un mail unique à Titi dans lequel il sera écrit quelque chose comme "les données de EEE FFF & KKK LLL ne sont pas à jour".

Et je pense qu'avec ça, j'obtiendrai ce que j’espérais tant

merci encore et bonne journée !

 

[Hasco]

Bonjour,

Comme vous avez excel 2016 vous pouvez recourir à PowerQuery (Données/Nouvelles requête) pour extraire de votre tableau de salariés les lignes dont la date de mise à jour est dépassée de 365 jours.

Puis éventuellement faire une deuxième requête à partir de la précédente pour préparer les mails.

Il resterait alors qu'une simple macro d'envoi des mails qui prendrait les différents éléments de cette dernière.
(P.S. votre tableau de salariés ne comporte pas d'email, alors j'ai créée dans la requête des emails fictifs comme les votres)

Vous trouverez un exemple des deux requête ceci dans le fichier joint "classeur D10 - And PQ.xlsm" , Feuille Power Query

Dans l'autre fichier joint la macro exemple à parfaire ci-dessous:

Public Sub CheckAndSendMail2()
    ' Constante html de sauts de ligne
    Const BR2 As String = "<BR><BR>"
    ' Plage entière et ligne sur lesquelles la macro travaillera
    Dim rDatas As Range, rRow As Range
    ' Objets externes
    Dim dicMails As Object, MailApp As Object, MailItem As Object
    ' Tableau des valeurs de la colonne parcourue
    Dim Valeurs As Variant
    ' Compteurs de boucle
    Dim i As Integer, j As Integer
    ' Adresse mail, nom de l'analyste et tableaux des noms de dossier à mettre à jour
    Dim sMail As String, arrDossiers() As String, Phrase As String
    Dim vAnalyste As Variant
    '
    ' initialisation de la plage des données, et du tableau à parcourir
    Set rDatas = Feuil2.Range("T_Dépassés[#Data]")
    '
    ' le tableau contiendra les noms et adresses mails
    Valeurs = rDatas.Columns(7).Resize(, 2).Value
    '
    ' Récolter une liste d'items uniques des analystes et  leur adresses mails
    Set dicMails = CreateObject("scripting.dictionary")
    For i = 1 To UBound(Valeurs): dicMails(Valeurs(i, 1)) = Valeurs(i, 2): Next
    '
    ' Sortir si aucun email récupéré
    If dicMails.count = 0 Then Exit Sub
   
    '
    ' Parcourir le dictionaire
    For Each vAnalyste In dicMails.keys
        ' Adresse mails, et nom analyste en cours
        sMail = dicMails(vAnalyste)
        'sAnalyste = dicMails.keys(i)
        '
        ' initialisation des variables pour l'item parcouru
        j = 0
        Erase arrDossiers
        '
        ' parcourir les lignes de rDatas
        For Each rRow In rDatas.Rows
            '
            If rRow.Cells(1, 8) = sMail And IsDate(rRow.Cells(1, 6)) Then
                ' Voir s'il est réellement nécessaire de conserver ce test sur la date
                ' Normalement si la ligne est dans le tableau c'est qu'elle est à mettre à jour
                If rRow.Cells(1, 6) - Date < -365 Then
                    ' ajout du nom prénom des dossiers
                    j = j + 1
                    ReDim Preserve arrDossiers(1 To j)
                    arrDossiers(j) = rRow.Cells(1, 2) & " " & rRow.Cells(1, 3)
                End If
            End If
        Next
        If MailApp Is Nothing Then Set MailApp = CreateObject("Outlook.Application")
        If j > 1 Then
            Phrase = "Les " & j & " dossiers ci-dessous sont à mettre à jour/!\"
        Else
            Phrase = "Le dossier ci-dessous est à mettre à jour/!\"
        End If
        Set MailItem = MailApp.createItem(0)
        With MailItem
            .Subject = "/!\ " & vAnalyste & " - Dossier à mettre à jour /!\ "
            .HtmlBody = "<HTML><BODY>" & _
                        "Bonjour " & vAnalyste & "," & BR2 & _
                        Phrase & BR2 & Join(arrDossiers, "<BR>") & BR2 & _
                        "</BODY></HTML>"
            '.display
            ' .send
        End With
        ' détruire la référence au mailItem
        Set MailItem = Nothing
     
    Next
    ' Détruire la référence à outlookApp
    Set MailApp = Nothing
End Sub

Bon après-midi