ENVOYER UN MAIL AVEC LOTUS NOTES 7 AVEC MULTI-DIFFUSION, CONTENU MESSAGE (BODY) MULTI-LIGNES, MOT DE PASSE LOTUS, PIÈCE JOINTE

'//En VB , ajouter la référence ("Projet > References"): LOTUS DOMINO OBJECTS (qui correspond à domobj.tbl)
' // En VBA,ajouter la référence ("Outils > References"): LOTUS DOMINO OBJECTS (qui correspond à domobj.tbl)
Sub EnvoiMail()
    Dim Email(6) As String
    Email(1) = "erenaud@compagnie-deutsch.com"
    Email(2) = "erenaud@wanadoo.fr"
    Email(3) = "contact@erenaud.fr"
    Email(4) = "dupont27@fr.fm"
    Email(5) = "duvert27@fr.fm"
    Email(6) = "durand27@laposte.net
    For i = 1 To 6
        Envoi = EnvoiNotesMail("Envoi mail Lotus V7", "C:\Excel\Postes commandes bloquées", Email(i), SaveIt:=True)
    Next i
End Sub

Function EnvoiNotesMail(Subject As String, Attachment As String, Recipient As String, SaveIt As Boolean) As Boolean
'*********************************************
'Repris et développé par EvilGost et complété par Eren
'Subject: Sujet du mail
'Attachment: Chemin complet du fichier à attacher (ex: "C:\test.txt"),
'sinon, mettre "" /
'Recipient: Destinataire (ex: "erenaud@wanadoo.fr")
'SaveIt: sauvegarde du mail dans les courriers envoyés
'*************************************************************************************************************
'Set up the objects required for Automation into Lotus Notes
    Dim Maildb As NotesDatabase    'The mail database
    Dim UserName As String    'The current users notes name
    Dim MailDoc As Object    'The mail document itself
    Dim AttachME As Object    'The attachment richtextfile object
    Dim oSession As NotesSession
    Dim dbDirectory As NotesDbDirectory
    Dim EmbedObj As Object    'The embedded object (Attachment)

    Dim objNotesField As Object ' Déclaration de la variable concernant le corps du message

    On Error GoTo ErrHandle

    Set oSession = New NotesSession
    'Démarre une session de notes
    
    ' La ligne suivante ne marche qu'avec les versions 5.x et 6.x ,
    ' c'est l'injection du mot de passe

    oSession.Initialize ("PASSWORD")

    'Récupère le nom par défaut de la session
    UserName = oSession.UserName

    'Ouvre la base mail en utilisant le serveur par défaut
    Set dbDirectory = oSession.GetDbDirectory("EVREUX01/DEUTSCH")    'vous pouvez mettre l'adresse du serveur dans ces parentheses
    Set Maildb = dbDirectory.OpenMailDatabase

    'Création du formulaire d'envoi de mail
    Set MailDoc = Maildb.CreateDocument()

    MailDoc.AppendItemValue "Subject", Subject  ' remplissage du Sujet
    MailDoc.AppendItemValue "SendTo", Recipient ' adresse du destinataire Email(i)
    MailDoc.AppendItemValue "ReturnReceipt", "1" ' pour avoir un accusé réception (qu'avec des clients Lotus, Orange)

    ' Construction du corps du message
    Set objNotesField = MailDoc.CreateRichTextItem("Body")

    With objNotesField
        .AppendText "Bonjour,"
        .AddNewLine 2
        .AppendText "Ci-joint la situation des postes bloqués."
        .AddNewLine 2
        .AppendText "Vous trouverez dans le fichier joint."
        .AddNewLine 2
        .AppendText "********************************************"
        .AddNewLine 2
        .AppendText "Cet e-mail a été généré par un processus automatique."
        .AddNewLine 2
        .AppendText "Cordialement"
        .AddNewLine 1
        .AppendText "Eric RENAUD"
        .AddNewLine 1
        .AppendText "Gestion Intégrée et Données"
        .AddNewLine 3
    End With

    'Permet d'attacher un document au mail
    If Attachment <> "" Then
        Set AttachME = MailDoc.CreateRichTextItem("Attachment")
        Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "Attachment")
    End If

    'Envoi du document

    If SaveIt = True Then
        MailDoc.SaveMessageOnSend = SaveIt    'si à True, Lotus sauvegarde le mail envoyé
    End If

    Call MailDoc.Send(False) 'j'obtiens une erreur lorsque je mets True au lieu de false, si quelqu'un sait pourquoi

    prvSendNotesMail = True
    GoTo ExitHandle

ErrHandle:
    MsgBox Err.Description
    prvSendNotesMail = False

ExitHandle:
    'Vidage mémoire
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set oSession = Nothing
    Set dbDirectory = Nothing
    Set EmbedObj = Nothing
End Function