[XL-2010] VBA - Draft mail sur Lotus 8.5 à partir d'excel

Bonjour,

J'ai récupéré un code VBA pour envoyer un mail directement à partir d'excel sur Lotus Notes 8.5. Ce mail a pour but d'envoyer des données quotidienne à des clients. Apres de longues recherche, j'ai terminé de le modifier et l'adapter mais je n'arrive pas à enlever la piéce jointe qui va avec. Dés que je supprime les lignes de codes concernant la PJ je perd également tout le coprs de texte.

Si vous pouviez jeter un oeil pour m'aider à le fixer ca serait superbe!!

Voici mon code:

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
 
 
Sub Test()
 
    Dim Session As Object
    Dim DB As Object
    Dim Doc As Object
    Dim Msg As String, Msg2 As String, Msg3 As String, Msg4 As String, Msg5 As String, Msg6 As String, Msg7 As String, PieceJointe1 As String, PieceJointe2 As String
 
    Dim oRichTextItem As Object
    Dim file_date As String
    Dim file_date2 As String
    Dim EditDoc As Object
    Dim Workspace As Object
 
    Dim Fichier As String
 
Dim dateReporting As Date
 
If weekday(Range("a13")) = "2" Then
dateReporting = DateSerial(Year(Date), Month(Date), Day(Date) - 3)
Else
dateReporting = DateSerial(Year(Date), Month(Date), Day(Date) - 1)
End If
 
 
   Const EMBED_ATTACHMENT = 1454
 
   'On Error GoTo TraiteErreur
 
    'Création de la session Notes
    Set Workspace = CreateObject("Notes.NotesUIWorkspace")
    Set Session = CreateObject("Notes.NotesSession")
    Set DB = Session.GetDatabase("", "")
    Call DB.OPENMAIL
    Set Doc = DB.CreateDocument
 
   'Creation d'un document
    Doc.Subject = " sujet  " & dateReporting
    Doc.Sendto = "  destinataire"
    Doc.CopyTo = " Cc "
 
 
    Set oRichTextItem = Doc.CreateRichTextItem("Body")
    Msg = vbCrLf & vbCrLf & "Bonjour, " & vbCrLf & vbCrLf & "Voici  la valeur...  " & vbCrLf & vbCrLf
    If Range("c6") = "ok" Then
        Msg2 = " Produit a:" & Range("d6") & " EUR " & vbNewLine
    Else: Msg2 = " Produit a: XXX " & vbNewLine
    End If
    If Range("c7") = "ok" Then
        Msg3 = " Produit b " & Range("d7") & " EUR " & vbNewLine
    Else: Msg3 = " Produit b : XXX " & vbNewLine
    End If
     If Range("c8") = "ok" Then
        Msg4 = " Produit c " & Range("d8") & " EUR " & vbNewLine
    Else: Msg4 = " Produit c XXX " & vbNewLine
    End If
    If Range("c9") = "ok" Then
        Msg5 = " Produit d  " & Range("d9") & " EUR " & vbNewLine
    Else: Msg5 = " Produit d:  XXX " & vbNewLine
    End If
     If Range("c10") = "ok" Then
        Msg6 = " Produit e " & Range("d10") & " EUR " & vbNewLine
    Else: Msg6 = " Produit e XXX " & vbNewLine
    End If
    Msg7 = vbCrLf & "A votre disposition pour tout renseignement," & vbCrLf & vbCrLf & "Bien Cordialement," & vbCrLf & vbCrLf
 
    Call oRichTextItem.AppendText(Msg & Msg2 & Msg3 & Msg4 & Msg5 & Msg6 & Msg7)
 
    'ajout de la pièce jointe
    PieceJointe1 = "I:\users\Service Client\... "
 
 
    Call oRichTextItem.EmbedObject(EMBED_ATTACHMENT, "", PieceJointe1)
 
    'Affichage du mail dans Lotus Notes
    Set EditDoc = Workspace.EditDocument(True, Doc)
 
    'Call Doc.ReplaceItemValue("$KeepPrivate", "1")
   ' Doc.Priority = "1" 'Selon les version "L", "H" ou "N"
 
'    'send
'    Doc.SaveMessageOnSend = True
'    Call Doc.Send(False)
'    Set Session = Nothing
'    MsgBox "Email sent.", vbOKOnly + vbInformation
 
 
    ' Réinitialisation des Objets
    Set Session = Nothing
    Set DB = Nothing
    Set Doc = Nothing
    Set Workspace = Nothing
    Set EditDoc = Nothing
 
    End Sub