Créer rdv outlook avec plusieurs destinataires

Bonjour,

Je souhaiterai utiliser une macro Excel que permette de créer un rdv outlook mais à plusieurs destinataires dont les adresses sont en j3 et j4 par exemple.

Après plusieurs forum j'ai réussi à trouver une macro fonctionnelle mais elle ne crée le rdv que sur mon adresse....

Auriez vous une solution ?

Voici ma macro trouvée sur le net.

Merci

Sub mail()

Dim oOutlook As Outlook.Application

Dim WasOutlookOpen As Boolean

Dim oMailItem As Outlook.MailItem

Dim Body As Variant

Dim oAppointment As Outlook.AppointmentItem

Dim namespaceOutlook As Outlook.Namespace

Dim DossierCalendrier As Outlook.MAPIFolder

texte = Sheets("TRAVAIL").Cells(25, 9).Value

'gestion d'erreurs

On Error GoTo Err_Execution

'on crée ensuite les objets

Set oOutlook = CreateObject("Outlook.Application")

Set namespaceOutlook=oOutlook.GetNamespace("MAPI")

'définit le dossier calendrier

'GetDefaultFolder renvoit le calendrier du compte actif

Set DossierCalendrier=namespaceOutlook.GetDefaultFolder(olFolderCalendar)

'on crée un nouveau rendez-vous

Set oAppointment = DossierCalendrier.Items.Add

'on renseigne ensuite les principaux paramètres

With oAppointment

.Start = "06/03/2019 11:10:00"

.Duration = 60 'durée de rdv, en minutes

.Subject = "CLES DYNAMOMETRIQUES" 'Sujet du rdv

.Body = texte 'corps du texte de la réunion

.Location = "HM2" 'Lieu du rdv

'on sauvegarde et ferme

.Save

.Close (olSave)

End With

'Libération des variables.

Set oAppointment = Nothing

Set oOutlook = Nothing

Fin_Execution:

Exit Sub

Err_Execution:

MsgBox Err.Description, vbExclamation

Resume Fin_Execution

End Sub

Bonjour

Sans fichier diffice de faire des tests... Mais essaye ça :

Rajoute dans les variable

Dim strMail As String

Après tu définie la variable :

strMail = Sheets("TaFeuille").Range("J3")&";"&Sheets("TaFeuille").Range("J4")

Puis dans

With oAppointment

tu met :

.Recipients.Add (strMail)

Essaye ce code :

Bien entendu, tu peux remplacer tous les paramètre du With par des formule du style Sheets("TaFeuille").Range("AdresseDeLaCelluleOuSeTrouveLinfoCorrespondate

Sub CreationReunion()

    Dim objOutlook As Outlook.Application
    Dim objReunion As Outlook.AppointmentItem
    Dim objExplorer As Outlook.Explorer
    Dim objSelection As Outlook.Selection

    Set objOutlook = Outlook.Application
    Set objExplorer = objOutlook.ActiveExplorer
    Set objSelection = objExplorer.Selection
    Set objReunion = objOutlook.CreateItem(olAppointmentItem)

    With objReunion
        .MeetingStatus = olMeeting
        .Subject = "test"
        .Body = "test 2"
        .Location = "Mon Bureau"
        .Recipients.Add (Sheets("TaFeuil").Range("J3")&";"&Sheets("TaFeuil").Range("J4"))
        .Display
        .Start = "07/03/2019 14:00"
        .Duration = 120
        .Send
        .Save
        .Close (olSave)
    End With

    Set objOutlook = Nothing
    Set objReunion = Nothing
    Set objExplorer = Nothing
    Set objSelection = Nothing

End Sub

Merci pour votre réponse rapide.

J'ai testé la macro se déroule normalement mais les destinataires n'ont toujours rien reçu....

N'y aurait il pas un problème avec la ligne:

Set dossiercalendrier ?

Merci

Si tu utilises uniquement le code ci-dessus est ce que ça marche ? Pour la sauvegarde dans un dossier Outlook on verra après

Le code me créé bien un rdv dans mon calendrier mais pas à ceux ajoutés dans récipients.add...

Il faut aussi que les destinataires acceptent le RDV ! Normalement après l’exécution du code un mail est envoyé aux destinataire leur indiquant qu'ils sont conviez à un RDV et qu'une réponse est nécessaire ! J'ai fait le test de mon coté et ça à marché

Ça ne lui demande aucun rdv à accepter...

Merci de votre aide je vais essayer de voir ça...

Essaye ça :

Effectivement je rencontre des difficultés à envoyer un mail. Mais cette manière fonctionne quand même !

Ou essaye ça, code trouvé sur le site de Microsoft :

Bonjour,

Je viens de tester ton avant dernière solution et ça marche nickel. Je te remercie pour ta rapidité !

Cordialement

Ok super ! Ya as de quoi