XL 2016 Envoi mail automatique une fois par semaine

[FaruSZ]

Bonjour,
Je voudrai envoyer des mails automatiques une fois par semaine a quelques personnes et ceci 2 mois avant la fin de validité de quelques éléments de ma base de données, j'ai le code suivant qui me permet d'envoyer les mails 2 mois avant la fin des dates mais je ne suis pas comment faire pour l'envoyer uniquement une fois par semaine.
Des propositions svp Merci

Dim Desti As String, Objet As String, Corps As String, olApp As Object
Sub AlertesDatesFormations() ' Formations externes
Dim Sh As Worksheet, Chaine As String, Lig As Integer, Alerte
Set olApp = CreateObject("Outlook.application")
Lig = 15 ' car les dates de validité se trouvent en ligne 15
For Each Sh In ActiveWorkbook.Sheets
If Sh.Range("A10") = "Formation externe " Then 'Formation concernée
Col = 2 ' car la premiére date de validité en en colonne B
While Sh.Cells(Lig - 5, Col) <> "" ' on regarde toutes les formations dans la colonne A10 (15-5=10)
If Sh.Cells(Lig, Col) <> "" And Sh.Cells(Lig, Col) < Date + 60 Then ' si formation et date
' on enrichit la chaine avec nom-date-formation
Chaine = Chaine & Sh.Name & vbTab & " Date: " & Sh.Cells(Lig, Col) & " " & Sh.Cells(Lig - 1, Col) & vbCrLf
End If
Col = Col + 1
Wend
If Chaine <> "" Then Chaine = Chaine & vbCrLf
End If
Next Sh
If Chaine <> "" Then
'MsgBox(Chaine, , "Alertes sur les dates de validit?formations.")
'  Alerte = MsgBox(Chaine, , "Alertes sur les dates de validitéformations.")
MsgBox Chaine, , "Alertes sur les dates de validité formations."
  Desti = "annabelle.delecour@nexans.com"
  Objet = "Alertes sur les dates de validité des Formations Externes "
  Corps = "Bonjour, ce message est un mail automatique, il vous informe sur la fin de valdité des formations externes, Merci "
  EnvoiMail Desti, Objet, Corps
End If
End Sub
Sub EnvoiMail(Desti As String, Objet As String, Corps As String)
  Dim M As Object
  Set M = olApp.CreateItem(olMailItem)
  With M
    .Subject = Objet
    .Body = Corps
    .Recipients.Add Desti
    .cc = "pascal.deguines@nexans.com;nicolas.debeyer@nexans.com"
    .send
  End With
End Sub

 

[sylvanu]

Bonjour FaruSZ,
Dans ThisWorkbook vous pourriez mettre cette macro :

Private Sub Workbook_Open()
     If Weekday(Now, 2) = 1 Then
        Call VotreMacroEmission
     End If
End Sub

VotreMacroEmission ne serait appeler à l'ouverture du fichier que si on est un Lundi.
Comme votre macro filtre les deux derniers mois, l'émission ne se ferait que tous les Lundi des deux derniers mois.

ou encore dans votre macro mettre le filtre :

If Weekday(Now, 2) = 1 Then
    ...
    ...
EndIf

WEEKDAY function - Microsoft Support

Returns the day of the week corresponding to a date. The day is given as an integer, ranging from 1 (Sunday) to 7 (Saturday), by default.

support.microsoft.com

 

[patricktoulon]

Bonjour
perso au lieu de vbmonday j'utiliserais (0) if Weekday(Now, vbUseSystemDayOfWeek)
sait on jamais avec les config PC

 

[FaruSZ]

Bonjour FaruSZ,
Dans ThisWorkbook vous pourriez mettre cette macro :

Private Sub Workbook_Open()
     If Weekday(Now, 2) = 1 Then
        Call VotreMacroEmission
     End If
End Sub

VotreMacroEmission ne serait appeler à l'ouverture du fichier que si on est un Lundi.
Comme votre macro filtre les deux derniers mois, l'émission ne se ferait que tous les Lundi des deux derniers mois.

ou encore dans votre macro mettre le filtre :

If Weekday(Now, 2) = 1 Then
    ...
    ...
EndIf

WEEKDAY function - Microsoft Support

Returns the day of the week corresponding to a date. The day is given as an integer, ranging from 1 (Sunday) to 7 (Saturday), by default.

support.microsoft.com

Merciii pour ta réponse je l'ai test et ca marche comme je veux merci encore