Utilisation bibliothèque Lotus avec VBA Access

Bonjour,

:cry: Je désespère de trouver une solution mais je suis sûr que quelqu'un à la solution.

J'ai posté ce problème sur plusieurs forums mais je n'ai jamais de réponse.
En cherchant, j'ai trouvé des morceaux de codes mais je ne sais pas faire le lien avec le corps du mail.

:( Je voudrais que le corps du texte reprenne un fichier HTML mais je n'arrive pas à faire le lien entre les données HTML et le corps du texte du mail Lotus.

Je vous met les lignes de mon programme avec les lignes de test qui ne fonctionne pas :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Function Test_Mail() 
    Dim subject As String 
    Dim Attachment As String 
    Dim RECIPIENT As String 
    Dim ccRecipient As String 
    Dim bccRecipient As String 
    Dim BodyText As String 
    Dim SaveIt As Boolean 
    Dim Password As String 
    Dim oRst, oSql As DAO.Recordset 
    Dim oFld As DAO.Field 
    Dim oRecip As DAO.Recordset 
 
    Dim Maildb As Object      'La base des mails 
    Dim UserName As String    'Le nom d'utilisateur 
    Dim MailDbName As String  'Le nom de la base des mails 
    Dim MailDoc As Object     'Le mail 
    Dim AttachME As Object    'L'objet pièce jointe en RTF 
    Dim Session As Object     'La session Notes 
    Dim EmbedObj As Object    'L'objet incorporé 
    Dim uidoc As Object 
    Dim bodypart As Object 
    Dim UserNom As Variant 
    Dim recip, Chemin, Fichier, Ets, Adresse As Variant 
    Dim sEmplacementInitial As String, sEmplacementFinal As String 
    Dim body As String 
    Dim workspace As lotus.NOTESUIWORKSPACE 
    Dim space As Object 
 
    DoCmd.SetWarnings False 
 
    'body = LoadRTFFile("C:\TEST\Document.htm") 
    'ltexte = Call notesUIDocument.Import( [ filter$ , filename$ ] ) 
    'Set otexte = oSource.Import("HTML", "C:\TEST\Document.htm") 
 
 
            Adresse = "C:\Documents and Settings\Eguillemard\My Documents\TEST\Document" 
            recip = " truc@truc.fr " 
 
            'Personne en copie des mails 
            bccRecipient = " truc@truc.fr " 
 
            'Sujet du mail 
            subject = "Mail Test " & Date 
 
            'Texte du mail 
            'BodyText = lTexte 
            'Set uidoc = workspace.CURRENTDOCUMENT 
            'uidoc.Import "HTML", "C:\TEST\Document.htm" 
 
             'Crée une session notes 
             Set Session = CreateObject("Notes.NotesSession") 
 
             '*** Cette ligne est réservée aux versions 5.x et supérieur : *** 
             'Session.Initialize (Password) 
 
             'Récupère le nom d'utilisateur et crée le nom de la base des mails 
             UserName = Session.UserName 
             MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf" 
 
             'Ouvre la base des mails 
             Set Maildb = Session.GetDatabase("", MailDbName) 
             If Not Maildb.IsOpen Then Maildb.Openmail 
 
             'Paramètre le mail à envoyer 
             Set MailDoc = Maildb.CreateDocument 
             MailDoc.Form = "Memo" 
             'supprime la dernière virgule 
            MailDoc.SendTo = Left(recip, Len(recip)) 
            MailDoc.CopyTo = ccRecipient 
            MailDoc.BlindCopyTo = bccRecipient 
            MailDoc.subject = subject 
 
            'Récupération du texte 
            Set bodypart = MailDoc.CreateRichTextItem("body") 
 
            With bodypart 
                .AppendText "Bonjour," 
            End With 
 
            'BodyText = bodypart 
            'MailDoc.body = bodypart 
 
            'Affichage du mail dans Lotus Notes 
            'Set space = CreateObject("Notes.NotesUIWorkspace") 
            'Call space.EditDocument(True, MailDoc).FieldSetText("Bodypart", bodypart) 
            'Set uidoc = workspace.CURRENTDOCUMENT 
            'Call uidoc.Import("HTML", "C:\Documents and Settings\Eguillemard\My Documents\TEST\Document.htm") 
 
            MailDoc.SAVEMESSAGEONSEND = SaveIt 
 
    '__________________________________________________________________________________________________________________________ 
 
             Attachment = "" & Adresse & "" 
 
             'Prend en compte les pièces jointes 
            If Attachment <> "" Then 
                Set AttachME = MailDoc.CreateRichTextItem("Attachment") 
                Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "Attachment") 
            End If 
 
             'Envoie le mail 
             MailDoc.PostedDate = Now() 
             MailDoc.send 0, recip 
 
             Set Maildb = Nothing 
             Set MailDoc = Nothing 
             Set AttachME = Nothing 
             Set Session = Nothing 
             Set EmbedObj = Nothing 
 
DoCmd.SetWarnings False 
 
End Function

Merci pour votre aide,

LeRico