Envoi mail 1 fois par semaine excel vba

Bonjour,

Je souhaite envoyer un mail 1 fois par semaine à certaines conditions...

L'idéal serait que la macro soit exécuté, une fois par semaine sans ouvrir le fichier, mais est-ce possible ?

Actuellement, c'est opérationnel, le lundi, mais avec le lundi de pâques, non travaillé.....

Plutôt que de spécifier le jour, je souhaite que la macro envoie un mail une seule fois, dans la semaine qu'importe le jour.....



Voici la macro en cours d'écriture...

Private Sub Workbook_Open()
Dim Desti As String, Feuille As String, TCD As String
Dim Fichier As String, Plage As Range
'
Worksheets("Données pour mail").Visible = True
Sheets("Données pour mail").Select
If Application.Weekday(Date) = 2 Then
i = 5
While Cells(i, 19).Value <> ""
i = i + 1
Wend
Cells(i, 19).Value = Date

If Application.Weekday(Date) = 2 Then 'le message est expédié tous les lundis
Fichier = "SUIVI FLOTTE.xlsm" 'le fichier doit être ouvert
Feuille = "Données pour mail" 'nom de la feuille
TCD = "Tableau4" 'nom
With Workbooks(Fichier).Sheets(Feuille)
Set Plage = .Range("a1:h42")
End With
Desti = Range("m13") 'destinataire du message
DestiCc = Range("m13") 'destinataire du message
EnvoiTCD Plage, Desti
End If
End If
Sheets("Base").Select
Worksheets("Données pour mail").Visible = False
End Sub

Function EnvoiTCD(Plage As Range, Desti As String)
Dim OutApp As Object, OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = Desti
.CC = DestiCc
.BCC = ""
.Subject = "Rappel Contrôle Technique et/ou Révision à effectuer - Message automatique - Ne pas répondre SVP"
.HTMLBody = RangetoHTML(Plage)
.Send 'or use .Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
Sheets("Base").Select
End Function
Function RangetoHTML(rng As Range)
'
'
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
Sheets("Base").Select
End Function


Merci d'avance !

pygos