Evénement Outlook selon date

Bonjour

Je voudrais que mon document excel envoie un événement sur la journée Outlook à une adresse mail en fonction d'une date (colonne V définie selon la colonne U par mois-1), puis indique oui sur la colonne W.

J'ai actuellement ce code mais il bloque, de plus je ne sais pas l'envoyer sue une adresse mail :

Sub AjoutRV()

Dim DLig As Long, Lig As Long

Dim OutObj As Object, OutAppt As Object

Dim DateRdv As Date, FlgRdv As Boolean

Dim HRDV As Date, PS As Date, FS As Date

' Créer une instance d'Outlook

Set OutObj = CreateObject("outlook.application")

' Avec la feuille

With Sheets("Effectif")

DLig = .Range("V" & Rows.Count).End(xlUp).Row

' Pour chaque ligne

For Lig = 4 To DLig

' Si une date de relance existe

If .Range("V" & Lig) <> "" Then

' Si un RDV n'a pas déjà été créé

If .Range("W" & Lig) <> "" Then

' Si le commentaire à changé

If .Range("W" & Lig) <> "oui" Then

FlgRdv = False

Else

' Sinon le commentaire n'a pas changé = pas de RDV

FlgRdv = False

End If

Else

' Sinon, pas de RDV déjà créé

FlgRdv = True

End If

Else

' Sinon, pas de date de relance

FlgRdv = False

End If

Else

' Sinon, pas de date de relance

FlgRdv = False

End If

' Si le FLAG est à vrai on créé le RDV

If FlgRdv Then

DateRdv = Range("V" & Lig)

HRDV = Range("E" & Lig).Value

PS = .Range("C" & Lig).Value

FS = .Range("D" & Lig).Value

Set OutAppt = OutObj.CreateItem(1)

With OutAppt

.Subject = "ATJM " & Sheets("Effectif").Range("A" & Lig) & " B "

.Start = DateRdv & " " & HRDV

.Duration = 45

.ReminderSet = True

.Save

End With

' Créer le commentaire et inscrire Oui

On Error Resume Next

.Range("G" & Lig).Comment.Delete

.Range("G" & Lig).AddComment Text:=.Range("F" & Lig).Value

.Range("G" & Lig) = "Oui"

On Error GoTo 0

End If

Next Lig

End With

Set OutAppt = Nothing

End Sub

Idem que pour mon second poste.

Appel à toutes les âmes charitables