Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Message en fonction d'une date

gilles37

XLDnaute Occasionnel
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
 
Trier par date Trier par votes

fanch55

XLDnaute Barbatruc
Bonjour,
le code ci-dessous devrait fonctionner :
VB: 
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
 
Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc
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 ...
 
Vote positif 0 Vote négatif

gilles37

XLDnaute Occasionnel
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.
 

Pièces jointes

  • RELANCE Copie.xlsm
    46.3 KB · Affichages: 10
Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc
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 ..
 
Dernière édition:
Vote positif 0 Vote négatif

gilles37

XLDnaute Occasionnel
fanch55 à dit:
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 ..
Cliquez pour agrandir...
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.
 

Pièces jointes

  • RELANCE PDP v4 .1 .0.1- Copy.xlsm
    160.6 KB · Affichages: 8
Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc
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)
VB: 
       nbreligne = Cells(Rows.Count, "G").End(xlUp).Row

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

Pièces jointes

  • RELANCE PDP v4 .1 .0.1- Copy.xlsm
    160.6 KB · Affichages: 11
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

R
  • Question
Microsoft 365 Mise en forme email
Réponses
7
Affichages
693
dysorthographie
K
  • Résolu(e)
XL 2019 Probleme codage
Réponses
2
Affichages
374
Kevin42560
K
V
  • Résolu(e)
Microsoft 365 Envoie mail automatique
2
Réponses
17
Affichages
2 K
vby
V
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
M
  • Question
XL 2016 Erreur d'execution '52': Nom ou numéro de fichier incorrect
Réponses
4
Affichages
1 K
macseb
M
C
  • Question
XL 2016 pièce jointe avec envoi mail VBA
Réponses
2
Affichages
2 K
CYRIL CAMPAS
C
L
  • Question
XL 2016 VBA Excel : Valeur récapituler sur un seul Mail
Réponses
10
Affichages
826
Gégé-45550
Z
  • Question
Microsoft 365 Supprimer un doublon en fonction d'une date et d'un numéro
Réponses
0
Affichages
446
Zifox
Z
P
  • Question
XL 2019 Ajouter une date de fin pour un débit/crédit récurrent via VBA
2
Réponses
19
Affichages
3 K
herve62
P
  • Question
XL 2019 Bloc if sans End If
Réponses
3
Affichages
1 K
Pounet95
P
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…