XL 2019 Message en fonction d'une date

[gilles37]

Bonjour,

Je souhaite dans la macro ci-dessous envoyer un message diffèrent si échéance 3 mois et 1 mois

msg a 3 mois: bonjour, le dossier arrive a expiration..
msg à 1 mois: bonjour, il vous reste plus qu'un mois pour nous communiquer votre dossier

Je bloque

Merci pour votre aide



Sub Alerte_Mail()
'
' Alerte_Mail Macro
'

nbreligne = WorksheetFunction.CountA(Columns(2))
nbrealerte = 0
objet = "Renouvellement "
'corps = "test"
For indextab = 2 To nbreligne Step 1

corps = "Bonjour" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Le dossier.... : " & Range("A" & indextab).Value & " arrive à expiration." & Chr(13) & Chr(10) & Chr(13) & Chr(10) & " Nous vous prions de:" & Chr(13) & Chr(10) & "- Prévoir son renouvellement " & Chr(13) & Chr(10) & "- Vérifier ..." & Chr(13) & Chr(10) & "- De confirmer la liste " & Chr(13) & Chr(10) & Chr(13) & Chr(10) & " Une fois " & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Bien cordialement,"

If Date = Date = DateAdd("m", -1, Range("G" & indextab).Value) Then


If Date = DateAdd("m", -3, Range("G" & indextab).Value) Or Date = DateAdd("m", -1, Range("G" & indextab).Value) Then
nbrealerte = nbrealerte + 1
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'corps du message si besoin
strbody = Contenu
With OutMail
.To = Range("J" & indextab).Value 'destinataire(s)
'.CC = "aaa@xx.com,bb@xx.com" ' copie
'.BCC = "aaa@xx.com,bb@xx.com" ' si BCC
.Subject = objet
.Body = corps
'Piece_jointe
'.Attachments.Add ("C:\test.txt") 'mettre chemin et fichier a joindre
'.Display 'ouvre Outlook
'or use
.Send 'envoi sans ouvrir Outlook
End With
Set OutMail = Nothing
Set OutApp = Nothing



End If
Next indextab
MsgBox ("Toutes les alertes ont été envoyé ! (nombre = " & nbrealerte & " )")


End Sub

 

[fanch55]

Bonjour,
le code ci-dessous devrait fonctionner :

Sub Alerte_Mail()
'
' Alerte_Mail Macro
'
dblf = vbLf & vbLf
nbreligne = WorksheetFunction.CountA(Columns(2))
nbrealerte = 0
objet = "Renouvellement "

For indextab = 2 To nbreligne Step 1
    
    Select Case DateDiff("m", Date, Range("G" & indextab)) ' en nombre de mois
        Case 3:     msg = "Le dossier arrive a expiration.."
        Case 1:     msg = "Il vous reste plus qu'un mois pour nous communiquer votre dossier"
        Case Else:  msg = vbNullString
    End Select

    If msg <> vbNullString Then
        corps = "Bonjour" & dblf & _
                msg & dblf & _
                "Nous vous prions de:" & vbLf & _
                " - Prévoir son renouvellement " & vbLf & _
                " - Vérifier ..." & vbLf & _
                " - De confirmer la liste " & dblf & _
                " Une fois " & dblf & _
                "Bien cordialement,"
        nbrealerte = nbrealerte + 1

        With CreateObject("Outlook.Application").CreateItem(0)
            .To = Range("J" & indextab).Value 'destinataire(s)
            '.CC = "aaa@xx.com,bb@xx.com" ' copie
            '.BCC = "aaa@xx.com,bb@xx.com" ' si BCC
            .Subject = objet
            .Body = corps
            'Piece_jointe
            '.Attachments.Add ("C:\test.txt") 'mettre chemin et fichier a joindre
            .Display True 'ouvre Outlook
            'or use
            '.Send 'envoi sans ouvrir Outlook
        End With

    End If
Next indextab

If nbrealerte > 0 Then MsgBox ("Toutes les alertes ont été envoyé ! (nombre = " & nbrealerte & " )")

End Sub

 

[gilles37]

merci Fanch55
Le souci est que le message ne part plus automatiquement. De plus, à la ligne 59, il n'y a plus d'analyse de date, donc pas de rappel je ne comprend pas.

 

[fanch55]

Bonsoir,
Il doit me manquer qq chose .
Un fichier exemple serait le bienvenu, car je ne sais pas comment l'alerte_Mail est lancé,
et je ne sais pas ce qu'est la ligne 59 ...

Rien n'est envoyé automatiquement effectivement, car j'ai juste fait un display et non un Send, à vous de le modifier si vous le désirez ...

 

[gilles37]

Bonjour

Ci-joint le fichier

 

[fanch55]

Salut,
Dans le fichier joint, la macro alerte mail n'est pas complète ou non fonctionnelle .
Avec un tableau vide, je ne sais pas quoi faire ...

 

[gilles37]

Salut,
Dans le fichier joint, la macro alerte mail n'est pas complète ou non fonctionnelle .
Avec un tableau vide, je ne sais pas quoi faire ...

 

[gilles37]

Bonjour,

Désolé pour le retard,
Je souhaiterais deux messages distant qui partiraient 3 mois et 1 mois avant la date déchéance en appuyant sur "alerte mail"
De plus, il semblerait qu'a la ligne 59 la macro ne fonctionne plus, je ne comprends pas.
Merci pour l'aide que vous pourriez m'apporter.

 

[fanch55]

Bonjour,
La macro Alerte_Mail originelle ne faisant que 49 lignes, je ne sais toujours pas ce qu'est la ligne 59 ?
La macro dans le fichier fourni n'est pas complète et non exécutable ..

 

[gilles37]

Bonjour,
La macro Alerte_Mail originelle ne faisant que 49 lignes, je ne sais toujours pas ce qu'est la ligne 59 ?
La macro dans le fichier fourni n'est pas complète et non exécutable ..

Bonjour,

Pour les deux messages differents, j'ai le fais avec 2 commandbutton et deux macros.
Par contre, j'ai toujours le souci, , qu il n'y a plas de message envoyage (donc n'analyse pas le tableau a partir la ligne 56. Je comprends pas.
Merci pour votre aide.

 

[fanch55]

Bonjour,
Au vu de la macro alerte_Mail2 dans le classeur envoyé :

nbreligne = WorksheetFunction.CountA(Columns(2))​

​

Vous déterminez le nombre d'itérations à effectuer à partir du nombre de cellules non vides dans la colonne B,
colonne qui est masquée et qui concerne la Rue bien souvent non renseignée.
Il y a effectivement 56 cellules Rue renseignées, ce qui explique la fin de la boucle à la ligne 56 ...
Utilisez plutôt la colonne qui est directement concernée c'est à dire la colonne G

nbreligne = WorksheetFunction.CountA(Columns("G"))​

Cependant, ce mode de calcul n'est pas conseillé car s'il y a des cellules non remplies en colonne "G" , vous aurez le même phénomène que pour la colonne 2

Pour déterminer le numéro de la dernière ligne jusqu'où itérer, utilisez plutôt :
( je ne l'avais pas fait dans la macro que je vous ai proposée car je ne connaissais pas le contexte)

       nbreligne = Cells(Rows.Count, "G").End(xlUp).Row

Vérifiez également la ligne 151 car le mois de septembre n'a pas 31 jours ...

 

[gilles37]

Bonjour Fanch55
J'avais complètement oublié la colonne cachée.
Je test et te redit cela.
Merci pour le temps passé