Test en fonction de la date du jour

cibleo · 21 Février 2010

Bonsoir le forum,

Dans ce bloc, la variable Msg représente le texte du message envoyé (TextBody) à chacun de mes destinataires (AdresMail)

Code:

Sub EnvoyerMailEtPDF()
Dim objMessage As CDO.Message
Dim sNomPDF As String
Dim sCheminPDF As String
Dim Prenom As String
Dim AdresMail As String
Dim [COLOR=red]Msg[/COLOR] As String
.../...
[COLOR=darkgreen]'---- Création et envoi message ------------[/COLOR]
With Sheets("MesDestinataires")
For Each cell In Range("C2:C6")
    If cell.Value Like "*@*" And cell.Offset(0, -2).Value = "x" Then
        Prenom = cell.Offset(0, -1).Value
        AdresMail = cell.Value
 
        [COLOR=red]'Composer le message[/COLOR]
[COLOR=red]Msg = "Bonjour " & Prenom & "," & vbCrLf & vbCrLf[/COLOR]
[COLOR=red]Msg = Msg & "Tu trouveras ci-joint le planning du jour." & vbCrLf & vbCrLf[/COLOR]
[COLOR=red]Msg = Msg & "Cordialement Cibleo"[/COLOR]
 
        Set objMessage = New CDO.Message
        'Set objMessage = CreateObject("CDO.Message")
        With objMessage
            .Subject = "Envoi Planning du jour à " & Prenom ' Sujet du mail
            .From = "[EMAIL="cibleo@wanadoo.fr"]cibleo@wanadoo.fr[/EMAIL]"
            .To = [COLOR=blue]AdresMail[/COLOR]
            ' Corps du mail
            [COLOR=red].TextBody = Msg[/COLOR]
            .AddAttachment sCheminPDF & sNomPDF ' Fichier joint au mail
            .Send '<<<<<<<<<<<<<<<Pour envoyer directement
        End With
    Set objMessage = Nothing
    End If
Next cell
End With
End Sub

Or, j'aimerais changer le texte du message à envoyer en fonction de la date du jour (Date systeme).

Il y aurait donc Msg1 envoyé le 1er et dernier jour du mois
et Msg envoyé les autres jours du mois.

Msg1 serait composé comme ci-dessous et reprendrait le contenu de Msg en y ajoutant la ligne surlignée en bleu.

'Composer le message
Msg1 = "Bonjour " & Prenom & "," & vbCrLf & vbCrLf
Msg1 = Msg1 & "Tu trouveras ci-joint le planning du jour." & vbCrLf & vbCrLf
Msg1 = Msg1 & "Cordialement Cibleo" & vbCrLf & vbCrLf
Msg1 = Msg1 & "N'oubliez pas de relever le compteur des voitures"

Pouvez-vous m'aider à introduire un nouveau test en fonction de la date du jour dans ce bloc d'instructions.

Merci de votre aide

Bonne soirée Cibleo

Excel-lent · 21 Février 2010

Re : Test en fonction de la date du jour

Bonsoir Cibleo,

cibleo à dit:
Msg1 envoyé le 1er et dernier jour du mois
et Msg envoyé les autres jours du mois.

Msg1 serait composé comme ci-dessous et reprendrait le contenu de Msg en y ajoutant la ligne surlignée en bleu.

Le code ci-dessous devrait faire ton affaire :

Code:

        [COLOR="Green"]'Composer le message[/COLOR]
        Msg = "Bonjour " & Prenom & "," & vbCrLf & vbCrLf
        Msg = Msg & "Tu trouveras ci-joint le planning du jour." & vbCrLf & vbCrLf
        Msg = Msg & "Cordialement Cibleo" & vbCrLf & vbCrLf
        [COLOR="Blue"]If Day(Now()) = 1 Or Month(Now()) <> Month(Now() + 1) Then Msg = Msg & "N'oubliez pas de relever le compteur des voitures"
        End If[/COLOR]

Dis nous si cela te convient.

Bonne soirée

Cordialement

cibleo · 22 Février 2010

Re : Test en fonction de la date du jour

Bonjour le forum,
Bonjour Excel-lent

C'est tout bon, voilà ta modification.

Code:

.../...
'[COLOR=darkgreen]---- Création et envoi message ------------[/COLOR]
For Each cell In Sheets("MesDestinataires").Columns("C").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "*@*" And cell.Offset(0, -2).Value = "x" Then
        Prenom = cell.Offset(0, -1).Value
        AdresMail = cell.Value
 
       [COLOR=red]'Composer le message[/COLOR]
[COLOR=red]      Msg = "Bonjour " & Prenom & "," & vbCrLf & vbCrLf[/COLOR]
[COLOR=red]      Msg = Msg & "Tu trouveras ci-joint le planning du jour." & vbCrLf & vbCrLf[/COLOR]
[COLOR=red]      Msg = Msg & "Cordialement Cibleo"[/COLOR]
        [COLOR=navy]If Day(Now()) = 1 Or Month(Now()) <> Month(Now() + 1) Then Msg = Msg & vbCrLf & vbCrLf & "N'oubliez pas de relever le compteur des voitures"[/COLOR]
 
        Set objMessage = New CDO.Message
        'Set objMessage = CreateObject("CDO.Message")
        With objMessage
            .Subject = "Envoi Planning du jour à " & Prenom ' Sujet du mail
            .From = "[EMAIL="cibleo@wanadoo.fr"]cibleo@wanadoo.fr[/EMAIL]"
            .To = [COLOR=blue]AdresMail[/COLOR]
            ' Corps du mail
            [COLOR=red].TextBody = Msg[/COLOR]
            .AddAttachment sCheminPDF & sNomPDF ' Fichier joint au mail
            .Send '<<<<<<<<<<<<<<<Pour envoyer directement
        End With
    Set objMessage = Nothing
    End If
Next cell
End Sub

J'ai revu la structure de ma boucle en remplaçant aussi :

Code:

With Sheets("MesDestinataires")
For Each cell In Range("C2:C6")

Par :

Code:

For Each cell In Sheets("MesDestinataires").Columns("C").Cells.SpecialCells(xlCellTypeConstants)

Merci
A+ Cibleo

cibleo · 24 Février 2010

Re : Test en fonction de la date du jour

Bonsoir le forum,

J'aimerais revenir sur la syntaxe de la condition ci-dessous.

N'y a t-il pas moyen de faire plus court ?

Code:

If Month(Now()) <> [COLOR=darkgreen]Month(Now()[/COLOR] + [COLOR=navy]3[/COLOR]) [COLOR=red]Or[/COLOR] Month(Now()) <> [COLOR=darkgreen]Month(Now()[/COLOR] + [COLOR=navy]2[/COLOR]) [COLOR=red]Or[/COLOR] Month(Now()) <>[COLOR=darkgreen] Month(Now()[/COLOR] + [COLOR=navy]1[/COLOR]) Then Msg = Msg & vbCrLf & vbCrLf & "N'oubliez pas de relever le compteur des voitures"

Cibleo

cibleo · 26 Février 2010

Re : Test en fonction de la date du jour

Bonsoir à tous,

Pour parvenir à mes fins, il faut que j'emploie la même formulation que Hasco dans le fil ci-dessous en utilisant Dateserial.

https://www.excel-downloads.com/threads/msg-de-fin-dannee.122892/

Cibleo

cibleo · 27 Février 2010

Re : Test en fonction de la date du jour

Re à tous,

Voilà, j'ai déclaré une variable comme ceci :

Code:

DJour1 As Date

Code:

DJour1 = DateSerial(Year(Date), Month(Date) + 1, 0)

Puis la condition :

Code:

If Date >= DJour1 - 2 And Date <= DJour1 Then Msg = Msg & vbCrLf & vbCrLf & "N'oubliez pas de relever le compteur des voitures"

A+ Cibleo

cibleo · 27 Février 2010

Re : Test en fonction de la date du jour

Bonsoir le forum

Ci dessous, le code compose et envoie un message personnalisé aux destinataires cochés en colonne A (feuille : MesDestinataires)

Voir l'illustration plus bas.

Code:

Sub EnvoyerMailEtPDF()
.../...
[COLOR=darkgreen]'---- Création et envoi message ------------[/COLOR]
For Each cell In Sheets("MesDestinataires").Columns("C").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "*@*" And cell.Offset(0, -2).Value = "x" Then
        Prenom = cell.Offset(0, -1).Value
        AdresMail = cell.Value
        [B][COLOR=red]Vehicule[/COLOR][/B] = cell.Offset(0, 1).Value
        [B][COLOR=red]CTTaxi[/COLOR][/B] = cell.Offset(0, 2).Value
        [B][COLOR=red]CTTech [/COLOR][/B]= cell.Offset(0, 3).Value
        DJour = Format(DateSerial(Year(Date), Month(Date) + 1, 0), "dd mmmm")
        DJourMois = DateSerial(Year(Date), Month(Date) + 1, 0) 'Dernier jour du mois en cours
 
        [COLOR=red]'Composer le message[/COLOR]
        Msg = "Bonjour " & Prenom & "," & vbCrLf & vbCrLf
        Msg = Msg & "Tu trouveras ci-joint le planning du jour." & vbCrLf
        Msg = Msg & "Cordialement Cibleo" & vbCrLf & vbCrLf
        [COLOR=navy]Msg = Msg & "Véhicule attribué : " & [B][COLOR=red]Vehicule[/COLOR][/B] & vbCrLf[/COLOR]
[COLOR=navy]        Msg = Msg & "Date limite Contrôle Taximètre : " & [B][COLOR=red]CTTaxi[/COLOR][/B] & vbCrLf[/COLOR]
[COLOR=navy]        Msg = Msg & "Date limite Contrôle Technique : " & [/COLOR][B][COLOR=red]CTTech[/COLOR][/B]
 
        [COLOR=darkred]If Date >= DJourMois - 2 And Date <= DJourMois Then Msg = Msg & vbCrLf & vbCrLf & "N'oublies pas de relever le compteur de ta voiture le " _[/COLOR]
[COLOR=darkred]& DJour & " au soir."[/COLOR]
 
 
        Set objMessage = New CDO.Message
        'Set objMessage = CreateObject("CDO.Message")
        With objMessage
            .Subject = "Envoi Planning du jour à " & Prenom ' Sujet du mail
            .From = "[EMAIL="cibleo@wanadoo.fr"]cibleo@wanadoo.fr[/EMAIL]"
            .To = AdresMail
            .TextBody =[B] Msg[/B]
            .AddAttachment sCheminPDF & sNomPDF ' Fichier joint au mail
            .Send '<<<<<<<<<<<<<<<Pour envoyer directement
        End With
    Set objMessage = Nothing
    End If
Next cell
End Sub

J'aimerais revenir sur la composition du message notamment sur les lignes surlignées en bleu qui correspondent à ce qui est entouré dans l'illustration.

En effet, ces lignes doivent apparaitre dans mon message seulement 30 jours avant les dates figurant en colonne E et F de la feuille "MesDestinataires"

Je sais qu'il faut introduire une nouvelle condition comme celle surlignée en rouge foncée, mais je ne sais pas comment faire référence au dates figurant en colonne E et F.

Pouvez-vous m'aider à revoir ma boucle, car ces différentes lignes apparaissent à chaque envoi.

Ci-joint le fichier.

Bonne soirée Cibleo

Test en fonction de la date du jour

cibleo

XLDnaute Impliqué

Pièces jointes

Excel-lent

XLDnaute Barbatruc

cibleo

XLDnaute Impliqué

cibleo

XLDnaute Impliqué

cibleo

XLDnaute Impliqué

cibleo

XLDnaute Impliqué

cibleo

XLDnaute Impliqué

Pièces jointes

Discussions similaires