Bonjour,
Pour avoir personnellement un peu galéré sur le sujet , j'ai glané çà et là des informations.
Juste retour des choses après avoir sollicité votre aide sur d'autres sujets, je vous propose une solution complète...
Celle-ci permet d'automatiser l'envoi d'Email:
- avec choix interactif de pièce(s) jointe(s)
- Sélection de destinataire(s) définis préalablement dans une feuille de calcul (complétion des champs TO et CC de l'email)
- Récupération du sujet et du corps de message (Complétion des champs SUBJECT et BODY de l'email)
Les axes d'amélioration :Saisie interactive du sujet et du corps de message.
Espérant que cette modeste contribution soit utile...
Bien cordialement,
Ipéfix
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 Sub EnvoiMail_PieceJointe() 'Necessite la référence à Microsoft Outlook xx Object Library (Outils_Réferences) Dim Fichiers As Variant Dim i As Integer Dim Ol As Outlook.Application Dim olMail As MailItem Dim Pri_Dest As String Dim Sec_Dest As String 'Récupération de la liste des destinataires (feuille DESINATAIRES du classeur) Pri_Dest = Worksheets("Destinataires").Range("B20").Value Sec_Dest = Worksheets("Destinataires").Range("C20").Value 'Sélection du ou des fichiers à joindre" Fichiers = Application.GetOpenFilename("Tous les fichiers (*.*),*.*", , , , True) Set Ol = New Outlook.Application Set olMail = Ol.CreateItem(olMailItem) ' Mise en forme de l'Email With olMail 'Destinataire .To = Pri_Dest 'Complétion de l'Email .CC = Sec_Dest .Subject = "TEST EMAILING " .Body = "Bonjour," & vbCrLf & "Voici le fichier attendu, actualisé au " & Date - 1 & vbCrLf & _ vbCrLf & "Cordialement." & vbCrLf & "Ipéfix" 'Permet la sélection multiples de fichiers puis intègre les pièces jointes dans l'Email '(La sélection multiple de fichiers se fait par la touche CTRL + clic gauche) If IsArray(Fichiers) Then For i = 1 To UBound(Fichiers) .Attachments.Add Fichiers(i) Next End If 'Au choix, Affichage ou Envoi de l'Email 'Affiche l'Email .Display 'Envoi de l'Email '.Send End With End Sub
Une variante, avec les destinataires "en dur" dans le code :
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 Sub EnvoiMail_PieceJointe() 'Necessite la référence à Microsoft Outlook xx Object Library (Outils_Réferences) Dim Fichiers As Variant Dim i As Integer Dim Ol As Outlook.Application Dim olMail As MailItem Dim Pri_Dest As String Dim Sec_Dest As String 'Sélection du ou des fichiers à joindre" Fichiers = Application.GetOpenFilename("Tous les fichiers (*.*),*.*", , , , True) Set Ol = New Outlook.Application Set olMail = Ol.CreateItem(olMailItem) ' Mise en forme de l'Email With olMail 'Destinataire(s) .To = "Toto@bibi.org;Bebert@nowhere.com" 'Complétion de l'Email .CC = "Loulou@bob.com;Tonton@salut.net" .Subject = "Mise à jour du fichier hebdomadaire " .Body = "Bonjour," & vbCrLf & "Voici le fichier attendu, actualisé au " & Date - 1 & vbCrLf & _ vbCrLf & "Cordialement." & vbCrLf & "Ipéfix" 'Permet la sélection multiples de fichiers puis intègre les pièces jointes dans l'Email '(La sélection multiple de fichiers se fait par la touche CTRL + clic gauche) If IsArray(Fichiers) Then For i = 1 To UBound(Fichiers) .Attachments.Add Fichiers(i) Next End If 'Au choix, Affichage ou Envoi de l'Email 'Affiche l'Email .Display 'Envoi de l'Email '.Send End With End Sub
Partager