Insertion lien hypertexte dans invitation Outlook

Bonjour,

Je cherche à avoir une macro qui me permet d'envoyer une invitation. J'arrive à intégrer tout ce que je veux... mais le corps de l'invitation me donne du fil à retordre. Je n'arrive pas à y insérer un lien dans le corps.... j'y arrive dans un mail, mais pas dans une invitation.

Si quelqu'un à une solution, je suis preneuse 😊

Merci pour votre aide 😉

Sub invit_astreinte()
'Envoi invitation à tous les agents d'astreinte

Dim messagerie As Object, invitation As Object
Dim participants As Range
Dim fichier As String
Dim chemin As String
Dim lien As String

fichier = Range("E9") 'Nom du fichier.xlsm
chemin = "C:\FICHIERS_EXERCICES_FORMATION/" & fichier 'chemin complet
lien = Range("E13")

'transformation cellule qui contien chemin accès en lien
Sheets("Mailing").Select
Range("E13").Select
Selection.Hyperlinks.Add Anchor:=Selection, Address:=chemin

    Set participants = Range("E3")
    Set messagerie = CreateObject("Outlook.Application")
    Set invitation = messagerie.CreateItem(1)

    With invitation
        .MeetingStatus = 1
        .Subject = Range("E4").Value
        .Location = "Astreinte"
        .Start = Range("E5").Value
        .Duration = Range("E14").Value
        .Body = "Bonjour," & vbCrLf & _
                    "Ci-après le lien pour renseigner le rapport à la fin de l'astreinte : " & lien & vbCrLf & _
                    "Bonne journée," & vbCrLf & _
                    "C"
        .RequiredAttendees = Range("E3")
        .BusyStatus = 0
        .ReminderMinutesBeforeStart = Range("E14")
        .display

    End With

Bonjour,

Voici un code à adapter

Sub inviter_texte()    
    With CreateObject("Outlook.Application").CreateItem(1)
        .MeetingStatus = 1
        .Subject = Range("inv_obj").Value
        .Location = Range("inv_lieu").Value
        .Start = Range("inv_date").Value + Range("inv_heure").Value
        .Duration = Range("inv_durée").Value * 24 * 60
        If Range("inv_rappel").Value > 0 Then
            .ReminderSet = True
            .ReminderMinutesBeforeStart = Range("inv_rappel").Value
        Else
            .ReminderSet = False
        End If

      ' Set participant = .Recipients.Add(Range("Listeboxsortie").Value)

      '  Il faut absolument faire un display au préalable pour accèder au WordEditor
        .display

        Cible = "https:/........../....../......"
        Set Wd = .GetInspector.WordEditor
        With Wd
            .Range.Text = "Ceci est ma 1ère ligne avec 2 retours à la ligne" & vbLf & vbLf
            .Range.InsertParagraphAfter
            .Range.Hyperlinks.Add Anchor:=.Paragraphs(.Paragraphs.Count).Range, _
                                  TextToDisplay:="Link", Address:=Cible
            .Range.InsertParagraphAfter
            .Paragraphs(.Paragraphs.Count).Range.Text = "Ceci est ma dernière ligne "
        End With
       ' .Send
    End With
End Sub

A+

Bonjour JExceL2fr,

Merci pour ton aide mais je n'arrive pas à l'adapter lorsque j'arrive sur la ligne "Set Wd = .GetInspector.WordEditor" le message d'erreur suivant est affiché :

Re,

Désolé pour vous, car de mon côté ça fonctionne

La preuve

Toujours le même message d'erreur 😕

Si je lance la macro, la fenêtre invit s'ouvre bien, mais je n'ai rien dans le corps et la macro stoppe sur la ligne Set Wd = .GetInspector.WordEditor

Re,

Question, vous ne seriez pas sur la nouvelle version d'Outlook par hasard

Ceci expliquerait cela...

Oui... du coup j'ai contourné mon problème, je créé mon invit et la met en pj d'un mail... dans lequel je peux mettre mon lien :)

Merci pour votre aide JExceL2fr :)