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

Effectuez une recherche sur Excel Downloads...

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

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums