Code Réunions Outlook

Bonjour,

J'ai un petit souci avec ce code qui inclut automatiquement l'adresse email du contact.
Je dois ouvrir une 2ème fois Outlook pour que celle-ci s'affiche.

À partir d'un formulaire de recherche, j'affiche les coordonnées du contact
et ensuite je clique sur Réunion.

Comment éviter celà? Voici le code:

Sub Reunions()
Dim olApp As Outlook.Application
Dim rns As Outlook.AppointmentItem
Dim objRecip As Outlook.Recipient
Dim Name As String

On Error Resume Next
Name = Nouveau.Prénom.Value & " " & Nouveau.Nom.Value & " " & Nouveau.Email.Value

Set olApp = Outlook.Application
Set rns = olApp.CreateItem(olAppointmentItem)
Set objRecip = rns.Recipients.Add(Name)

With rns
.Recipients.Add (Name) - 1 ' - 1 évite d'avoir 2 fois la même adresse
.MeetingStatus = olMeeting
.Importance = olImportanceNormal
.Subject = ""
.Body = ""
.Location = ""
.Start = Now
.Duration = 0
.Categories = ""
.Display
End With

Set olApp = Nothing
Set rns = Nothing
End Sub

Merci d'avance