macro envoi corps de texte dans mail (lotus)

' --------- Envoi d'un mail avec Lotus Notes ---------- .
'Ajouter la référence Lotus Domino Objects (domobj.tlb) .
'Cocher Référence  [x]Lotus Domino Objects              .
'entrée du CheminEtFichier s'il y a lieu
'entrée Sujet et Message As String
Public Sub EnvoiMailLocal(CheminEtFichier As String, Sujet As String, Message As String)
Dim oSession As Object     'CreateObject("Notes.NotesSession")
Dim UserName As String     'Nom d'utilisateur
Dim DataBase As Object     'Base des mails
Dim DataBaseName As String 'Nom de la base
Dim Document As Object     'Mail
Dim AttachME As Object     'Fich joint en RTF
Dim AttachF1 As Object     '1' pièce attachée

On Error GoTo ErreurNET: Err.Clear '*****

' Crée la session
Set oSession = CreateObject("Notes.NotesSession")
' Récupère nom d'utilisateur
UserName = oSession.UserName
DataBaseName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
' Ouvre la base des mails (si fermé, ouvre et demande le password)
Set DataBase = oSession.GetDataBase("", DataBaseName)
If Not DataBase.IsOpen Then DataBase.OpenMail

'########################## envoi ###############################################
'récupère dans la feuille nommée NomDeLaFeuilDATA$ et le Range nommé "CellDATA_AdresDestinataire"
'les adresses séparées par ";"
Dim Tablo As Variant, AdresDestinataire As String
AdresDestinataire = Sheets(NomDeLaFeuilDATA$).Range("CellDATA_AdresDestinataire")
If InStr(AdresDestinataire, ";") = 0 Then AdresDestinataire = AdresDestinataire & ";"
Tablo = Split(AdresDestinataire, ";")
'       boucle envoi                 .
For I = LBound(Tablo) To UBound(Tablo)
 If Trim(Tablo(I)) > "" Then
    AdresDestinataire = Tablo(I)
    'crée le document et colle /AdresDestinataire /Sujet /Message
    Set Document = DataBase.CreateDocument
    Document.Form = "Memo"
    Document.Sendto = AdresDestinataire
    Document.Subject = Sujet
    Document.Body = Message
    'Joint le Fichier s'il y en a un !?
    If CheminEtFichier <> "" Then
       Set AttachME = Document.CreateRichTextItem("Attachment")
       Set AttachF1 = AttachME.EmbedObject(1454, "", CheminEtFichier, "Attachment")
    End If
    'Envoi le Mail
    Document.SaveMessageOnSend = True 'True svg dans les courriers envoyés
    Document.PostedDate = Now()
    Document.Send 0, AdresDestinataire
    ' suite...
    Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
 End If
Next
GoTo FinMail ' fin ##############################################################

ErreurNET:
Msg$ = "Erreur " & Err.Source & "  No " & Err.Number & vbLf & vbLf & Err.Description
T$ = "Envoi Mail: Problème de connexion !?"
MsgBox Msg$, vbCritical, T$, Err.HelpFile, Err.HelpContext
GoTo FinMail

FinMail:
Set oSession = Nothing: Set DataBase = Nothing
Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
On Error GoTo 0: Err.Clear
End Sub