Extraire texte de cellules et insérer ce texte dans un email.

Sub SendMail_Outlook()
    Dim OL As Object
    Dim OLmail As Object
    Dim MyItem As Outlook.MailItem
   
   'test si Outlook est ouvert
    Set OLk_Appli = CreateObject("Outlook.Application")
    If OLk_Appli.Explorers.Count > 0 Then
        'Ok outlook ouvert
    Else
        'mettre le bon chemin outlook
        OLk_OK = Shell("C:\Program Files (x86)\Microsoft Office\Office15\outlook.exe", vbHide)
    End If
   
    Set OL = CreateObject("Outlook.Application")
    '---------------
    'avec Model
    Set MyItem = OL.CreateItemFromTemplate("Chemin et nom du model")
    'si piece jointe: chemin piece-jointe
    'piece_jointe=""
    With MyItem
        .To = "zzzzzzzzzz@fai.xxxxx"
        .Subject = Range("A1")      ' a vous de mettre ce que vous avez besoin
        '.Body = "azerty template"      'a vous de mettre ce que vous avez besoin
        '.AddAttachment (piece_jointe)
        '.Display        'attente envoi manuel
        .Send          'envoi auto
    End With
    
    'tempo attente avant fermeture Outlook
    temps = Timer
    Do While Timer - temps < 2
        DoEvents
    Loop
    
    'close Outlook
    OLk_Appli.ActiveExplorer
    OLk_Appli.Quit
    Set OLmail = Nothing
    Set OL = Nothing
    Set OLk_Appli = Nothing

End Sub