Discussion :

[jeanmi01]

Bonjour,

je recherche le moyen d'automatiser l'envoi de mail lotus notes via une macro excel. J'ai pu trouver de nombreuses informations sur le forum et aujourd'hui je suis bloqué sur la dernière étape.

Mon but est de créer un mail qui contient un tableau à onglet lotus (via appendtable) et dans les onglets de ce tableau, je souhaite pouvoir coller une plage de donnée de ma feuille excel mais au format bitmap.

Aujourdh'ui, j'arrive à créer le mail, à inclure le tableau à onglet mais mon problème est que je n'arrive pas à coller la plage de donnée (ou une image) dans les onglets.

Merci d'avance pour vos réponses.

[ZebreLoup]

Salut,
La première étape pour que l'on puisse t'aider serait de donner ton code actuel en précisant où il manque cette dernière étape.

[Godzestla]

Bonjour,
je suis très intéressé par ton code.
Je sais créer un email notes, ajouter des attachements, mais un tableau à onglet je ne sais pas faire.

[jeanmi01]

Salut,
désolé pour le temps de réponse,
voici mon code actuel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
Sub envoi_mail_Suivi()

    'Déclaration
    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 UIdoc As Object          'Le mail
    Dim AttachME As Object       'L'objet pièce jointe en RTF
    Dim Session As Object        'La session Notes
    Dim Signature As String      'signature
    Dim EmbedObj As Object       'L'objet incorporé
    Dim MyStyle As Object        'Mise en forme du corp de texte
    Dim recip(25) As Variant     'liste destinataire
    Dim Recipient(25) As Variant 'liste destinataire
    Dim Plage As Object          'Tableau suivi
    Dim rows As Integer
    Dim columns As Integer
    Dim tabs() As String
    Dim rtnav As Object
    

    'Crée une session notes
    Set Session = CreateObject("Notes.NotesSession")
    
    '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 Maildb.IsOpen = True Then
        WasOpen = 1 'Déja ouvert
    Else
        WasOpen = 0
        Maildb.OPENMAIL 'Ouverture de la base mail
    End If
    
    'Paramètre le mail à envoyer
    Set MailDoc = Maildb.CREATEDOCUMENT
    
    
   MailDoc.Form = "Memo"
   'MailDoc.SIGNONSEND = True
   
   w_la_date = Format(Date, "dd/mm/yyyy")
      
   'Mise à jour du numéro
   'If Sheets("param").Cells(2, 2).Value <> w_la_date Then
   '   Sheets("param").Cells(2, 2).Value = Format(Date, "dd/mm/yyyy")
   '   Sheets("param").Cells(2, 3).Value = 1
   'Else
      'Mise à jour du numéro
   '   w_numero = Sheets("param").Cells(2, 3).Value
   '   Sheets("param").Cells(2, 3).Value = w_numero + 1
   'End If
   
   w_la_date2 = Format(Sheets("param").Cells(2, 2).Value, "dd-mm-yyyy")
   
      
   MailDoc.Subject = Sheets("param").Cells(2, 1).Value & " " & Sheets("param").Cells(2, 2).Value & "N°" & Sheets("param").Cells(2, 3).Value
   
   'Destinataire
    j = 0
    For i = 2 To 20
        If Sheets("param").Cells(i, 6).Value <> "" Then
           Recipient(j) = Sheets("Param").Cells(i, 6).Value
           j = j + 1
         End If
    Next i
  
    'Destinataires Copie
    cRecipient = ""
    j = 0
    For i = 2 To 20
        If Sheets("Param").Cells(i, 7).Value <> "" Then
           recip(j) = Sheets("Param").Cells(i, 7).Value
           j = j + 1
         End If
    Next i
    
    MailDoc.sendto = Recipient
    MailDoc.copyto = recip
    
    'récupération de la signature Notes
    Signature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
    'récupération du titre
    MailDoc.AppendItemValue ("iTitle"), Maildb.GetProfileDocument("CalendarProfile").GetItemValue("iTitle")
    MailDoc.Logo = "StdNotesLtr99"

   
    'texte mail
    Set rtitem = MailDoc.CREATERICHTEXTITEM("Body")
       Set MyStyle = Session.CreateRichTextStyle
         With rtitem
             MyStyle.Bold = True
             MyStyle.FontSize = 12
             Call rtitem.AppendStyle(MyStyle)
             .Addtab (6)
             .AppendText (Sheets("param").Cells(2, 4).Value & " " & w_la_date2 & " N°" & Sheets("param").Cells(2, 3).Value)
             .ADDNEWLINE (1)
             MyStyle.Bold = False
             MyStyle.FontSize = 10
             Call rtitem.AppendStyle(MyStyle)
         End With
    
    'Creation tableau onglet
    rows = 2
    columns = 1
    ReDim tabs(1 To rows)
    tabs(1) = "Dashboard"
    tabs(2) = "Details"

    Call rtitem.Appendtable(rows, columns, tabs)    
    'Remarque si besoin
    If Sheets("param").Cells(2, 8).Value <> "" Then
       Call rtitem.ADDNEWLINE(2)
       Call rtitem.AppendText("Remarque : " & Sheets("param").Range("H2").Value)
    End If

   'signature
    Call rtitem.ADDNEWLINE(2)
    Call rtitem.AppendText(Signature)
    Call rtitem.ADDNEWLINE(2)
    

    'sauvegarde du mail dans ENVOYE
    MailDoc.SAVEMESSAGEONSEND = SaveIt
    
    'Envoie le mail (commande SEND, ou le génère seulement automatiquement)
     MailDoc.PostedDate = Now()
    'MailDoc.SEND 0, Recipient
    'MailDoc.SEND 0, cRecipient
    Call MailDoc.Save(True, False) 
     
    Set Workspace = CreateObject("Notes.NotesUIWorkspace")
    Call Workspace.EDITDOCUMENT(True, MailDoc).GoToField("body")
    
    Set UIdoc = Workspace.CurrentDocument
    UIdoc.EditMode = True
    
    'Copie Tableau1
    For i = 1 To 20
        If Sheets("suivi").Cells(i, 1).Value = "header1" Then
           Tab1 = i
        Else
           If Sheets("suivi").Cells(i, 1).Value = "Fin1" Then
              Tab2 = i - 1
           End If
        End If
    Next i
    
    RowTab1 = "B" & Tab1
    ColTab1 = "I" & Tab2
    
    
    Sheets("Suivi").Range(RowTab1 & ":" & ColTab1).CopyPicture Format:=xlBitmap
    Call UIdoc.Paste
    'Call UIdoc.InsertText(vbCrLf)
    
    'Copie Tableau2
    For i = 1 To 50
        If Sheets("suivi").Cells(i, 1).Value = "header2" Then
           Tab3 = i
        Else
           If Sheets("suivi").Cells(i, 1).Value = "Fin2" Then
              Tab4 = i - 1
           End If
        End If
    Next i
    
    RowTab2 = "D" & Tab3
    ColTab2 = "I" & Tab4

'--> Je souhaiterai pouvoir me positionner dans mon tableau à onglet et coller ma sélection   
 
    Sheets("Suivi").Range(RowTab2 & ":" & ColTab2).CopyPicture Format:=xlBitmap
    Call UIdoc.Paste
    'Call UIdoc.InsertText(vbCrLf)
    
End Sub

merci d'avance

[jeanmi01]

un petit coup de pouce ???