1 pièce(s) jointe(s)
Envoi de mail par macro VBA
Bonjour à tous,
J'ai rédigé une macro pour envoyer des mails automatiques en joignant un pdf par outlook.
Tout fonctionne bien MAIS je souhaiterais mettre un format sur mon corps de texte.
Aujourd'hui avec ma technique cela ne met aucun espace ni saut de ligne.
je joins un exemple de mon fichier (onglet 1) et voici le code que j'utilise :
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
115
116
117
118
119
120
121
122
123
124
|
Sub EnvoiMail()
Dim Suivi_Anim, Onglet, definition_objet
'*****************************************'
'Macro permettant l'envoi par mail du PDF '
'*****************************************'
'-----------------------------------'
'Impression en PDF pour PJ Mail '
'-----------------------------------'
Sheets("Pilote").Activate
<div style="text-align: right;">
colonne_nom_ifs = Sheets("Pilote").Range("COL_NOM_IFS_SORTIE").Value
col_filtre_fiche_ifs = Sheets("Pilote").Range("COLONNE_FILTRE_PARTICIPATION_FICHE_IFS").Value
valeur_filtre_fiche_ifs = Sheets("Pilote").Range("VALEUR_FILTRE_PARTICIPATION_FICHE_IFS").Value
objet_mail = Sheets("Pilote").Range("FICHE_IFS_OBJET_MAIL").Value
corps_mail = Sheets("Pilote").Range("FICHE_IFS_CORPS_MAIL").Value
date_maj = Sheets("Procédure").Range("DATE_MAJ_CUBE").Value
Sheets("Procédure").Activate
Chemin = Range("CHEMIN_ENR_PDF").Value
'C:\Documents\FICHES_IFS\
Sheets("IFS_").Activate
For Each ligne In Range("F9:F21").SpecialCells(xlCellTypeVisible).Rows
i = ligne.Row
nom_ifs = Sheets("IFS_").Cells(i, colonne_nom_ifs).Value
Sheets("Fiche_IFS").Activate
Range("FICHE_IFS_SELECTIONNE").Value = nom_ifs
Calculate
ActiveSheet.Range("$C$7:$CR$21").AutoFilter Field:=col_filtre_fiche_ifs, Criteria1:=valeur_filtre_fiche_ifs
If nom_ifs <> "" Then
</div> ad_mail = Range("FICHE_IFS_AD_MAIL_A").Value
ad_mail_cc = Range("FICHE_IFS_AD_MAIL_CC").Value
Onglet = ActiveSheet.Name
Sheets(Onglet).Select
Nom = Range("FICHE_IFS_NOM_PDF").Value
Chemin_IFS = Chemin & nom_ifs
'----------------------------------'
'Enregistrement en PDF de la fiche '
'----------------------------------'
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
Chemin & Nom, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
'--------------------'
'Préparation du mail '
'--------------------'
Dim OlApp As Object
Dim OlItem As Object
Set OlApp = CreateObject("Outlook.application")
Set OlItem = OlApp.CreateItem(0)
With OlItem
'----------------------------------------------------------------'
'To, CC = saisie des adresses mail par l'utilisateur de la macro '
'----------------------------------------------------------------'
.To = ad_mail
.CC = ad_mail_cc
'---------------'
' Objet du mail '
'---------------'
.Subject = objet_mail
'Corps du mail
'--------------------------------------------------------------------------------------'
'Pièce jointe : PDF qui vient d'être crée pour possibilité d'imprimer sous bon format '
'--------------------------------------------------------------------------------------'
.Attachments.Add (Chemin & Nom)
'-----------------------------------------------------------------------------------------------'
'Format du corps de mail : HTML + insère l'image créee precedemment dans le repertoire "C\Temp" '
'--------------------------------------------------------------------------------------'
.BodyFormat = 2
.HTMLBody = corps_mail
.display
OlItem.send
'------------------------'
'Retour au fichier Excel '
'------------------------'
End With
Sheets("Fiche_IFS").Activate
ActiveSheet.ShowAllData
End If
Sheets("IFS_").Activate
Next ligne
End Sub |
