declencher macro envoie mail

bonjour
j'ai une macro qui m'envoie un email automatiquement a plusieurs destinataire
comment faire pour trouver un code a mettre dans worbook open qu'il m'envoie le mail tous les premiere du mois a l'ouverture du classeur
et bien sur une securité pour qu'il ne l'envoie plus apres en double
voici ma macro:

Sub envoi_Feuille()
Application.ScreenUpdating = False
répertoireAppli = ActiveWorkbook.Path
Sheets(Array("Réception", "Cross Docking")).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\Cross docking PHOTOBOX du " & _
Format(Worksheets("Cross Docking").Range("a4"), "d\-mm\-yyyy") & ".xls"
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Object 'Outlook.Application
Sheets("Envoie Email").Select
Range("B18").Select

Set olapp = CreateObject("Outlook.Application")
Do While Not IsEmpty(ActiveCell)
Dim msg As Object 'MailItem
Set msg = olapp.CreateItem(0)
msg.To = ActiveCell.Value
msg.Subject = Range("B5").Value

msg.Body = Range("B8").Value & Chr(13) & Chr(13) & Range("B9").Value & Chr(13) & Chr(13) & Range("B10").Value & Chr(13) & Chr(13) & Range("B11").Value & Chr(13) & Chr(13) & Range("B12").Value & Chr(13) & Chr(13) & Range("B15").Value & Chr(13) & Chr(13)
msg.Attachments.Add répertoireAppli & "\Cross Docking PHOTOBOX du " & _
Format(Worksheets("cross docking").Range("a4"), "d\-mm\-yyyy") & ".xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
Set msg = Nothing
Set olapp = Nothing

Application.ScreenUpdating = True
MsgBox "Le Cross Docking a été envoyé par email avec succé ...."
End Sub

Julie