Bonjour
Je désespère car je viens d'essayer toutes les solutions que j'ai trouvées sur Internet mais en vain...
Je veux envoyer un mail avec pièce jointe et insertion d'un tableau dans le corps du mail.
J'ai 2 macros qui marchent... J'arrive à mettre des pièces jointes mais pas de tableau dans le corps du mail avec ma 1ère macro :
Ou jarrive a insérer un tableau dans le corps du Mail mais je n'arrive pas a joindre une pièce jointe :
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 Sub Mail() Dim Maildb As Object Dim UserName As String Dim MailDbName As String Dim MailDoc As Object Dim AttachME As Object ect Dim Session As Object Dim EmbedObj As Object 'définition du mail Set objNotesField = MailDoc.CREATERICHTEXTITEM("Body") With objNotesField .AppendText "Bonjour," .AddNewLine 2 .AppendText "Vous trouverez ci-joint " .AddNewLine 2 .AppendText "Cordialement," .AddNewLine 2 .AppendText Sheets("xx").Cells(12, 1).Value .AddNewLine 3 End With MailDoc.SaveMessageOnSend = SaveIt 'pièces jointes Attachment1 = Sheets("xx").Cells(1, 3).Value & Sheets("xx").Cells(16, 1).Value & ".xlsx" If Attachment1 <> "" Then Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment1") Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment1, "Attachment1") MailDoc.CREATERICHTEXTITEM (Attachment1) End If Attachment2 = Sheets("xx").Cells(1, 3).Value & Sheets("xx").Cells(17, 1).Value & ".xlsx" If Attachment2 <> "" Then Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment2") Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment2, "Attachment2") MailDoc.CREATERICHTEXTITEM (Attachment2) End If MailDoc.PostedDate = Now() MailDoc.Send 0, Recipient 'Clean Up Set Maildb = Nothing Set MailDoc = Nothing Set AttachME = Nothing Set Session = Nothing Set EmbedObj = Nothing End Sub
Est ce que quelqu'un saurait résoudre mon problème sur lune ou l'autre des maçros ?
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 Sub macro() Dim MailAd As String Dim Msg As String Dim Subj As String Dim URLto As String Range("E12:F22").Select 'copie une zone du fichier EXCEL" Selection.Copy Windows("_testxx.xlsm").Activate MailAd = Range("B8") 'adresse mail Copie = Range("B9") & Range("B10") 'adresse mail pour CC Subj = "Conclusion" 'objet du mail Msg = Msg & "Bonjour " & ",%0D%0A %0D%0A" 'Message préformaté Msg = Msg & "Vous trouverez ci-joint le dossier." & ", %0D%0A %0D%0A" 'Message préformaté avec du texte d'une cellule Msg = Msg & "Cordialement," & ", %0D%0A %0D%0A" 'Message préformaté avec du texte d'une cellule URLto = "mailto:" & MailAd & "?subject=" & Subj & "&body=" & Msg & "&Cc=" & Copie ActiveWorkbook.FollowHyperlink Address:=URLto End Sub 'coller le tableau et envoyer le mail à la main
Merci pour votre aide
Partager