Macro pour envoi d'un onglet par mail Résolu/Fermé

Question

Bonjour à tous, ceci est mon premier post sur ce forum ;)

Je suis complètement novice dans la rédaction de macros, et j'aurais besoin de vos lumières concernant une macro d'envoi de mail à partir d'une liste d'adresses. J'ajoute que j'aimerais déclencher cette macro par un bouton.
Je vous explique la mise en forme de mon fichier *.xls :

Dans mon classeur, un onglet par agent qui a comme nom le nom de l'agent. (il y a en tout une quarantaine d'agents, donc autant d'onglets) plus un onglet regroupant la liste des adresses mail de chaque personne.
Dans ce dernier onglet, en colonne A les noms des agents (et donc aussi le nom des onglets) et en colonne B les adresses mail correspondantes.

Ce que j'aimerais c'est qu'un bouton permette l'envoi à chaque personne de sa feuille personnelle, et uniquement celle-ci. (donc que le bouton commande l'envoi automatique d'une quarantaine de mails avec un contenu différent à chaque fois)

Merci de vous pencher sur mon problème!
Cordialement
Nounours ;)

ozone_ · Answer

Salut,

C'est possible si par exemple tu utilise outlook comme messagerie.
Il faudra procéder comme ci :
https://www.developpez.net/forums/d1189093/logiciels/microsoft-office/excel/macros-vba-excel/macro-excel-envoi-mail-pj-corps-texte/

Après si tu veux un exemple plus précis on aura besoin d'avoir un exemple de ton fichier posté sur https://www.cjoint.com/ par exemple.

Nounours_Poilu · Answer

Bonjour Ozone, merci de t'être penché sur mon problème.
D'après le lien que tu m'envoies, je pencherais pour un codage avec une boucle For/Next sur i pour lister toutes les pages. 
Maintenant je ne sais pas si l'expression "Sheets(i)" est prise en compte par Excel, ainsi que la plage "Range(A1:F18).Value"

Voilà ce que ça donnerait comme bout de code:

 With NewMail      For i = 1 to 4       .Recipients.Add (Sheets(i).Range("A1:F18").Value)              'Sujet :       .Subject = "sujet"       'Copies       .CC = "chef@test.com;adjoint@test.com"        'Corps du mail :       .Body = "Bonjour," & vbCrLf _       & vbCrLf _       & "Vous trouverez ci joint le  " & Sheets(i).Range("A1").Value & vbCrLf _       & vbCrLf _       & "Cordialement" & vbCrLf _       & vbCrLf & vbCrLf _       & "pseudo"        .Attachments.Add ActiveWorkbook.FullName       .Display       'Envoi :       .Send     Next End With

Je joins un fichier exemple au format *.xls mais créé avec Libre Office (pas taper! pas taper!)
je n'ai pas Excel ici à la maison, il faudra attendre mardi (week-end à rallonge oblige) pour que je teste ça au bureau sur Excel.

Voici un fichier dépersonnalisé:
https://www.cjoint.com/c/EEypegAIWs5
L'onglet "Bilan" regroupe toutes les adresses mail des agents.
Merci beaucoup,

Cordialement
Nounours

ozone_ · Answer

Re,
Alors voilà ce que j'ai pu faire :
Sub SendEmail()
 
Dim olApp As Outlook.Application
Set olApp = CreateObject("outlook.application")
Dim LWorkbook As Workbook
Dim LFileName As String
Dim i As Integer: i = 1

Do
        Dim olMail As Outlook.MailItem
        Set olMail = olApp.CreateItem(olMailItem)
        
        With olMail
           .Recipients.Add (Sheets("Bilan").Range("B" & i).Value)
           .Subject = "Fiche personnelle"
    
            Sheets(Sheets("Bilan").Range("A" & i).Value).Copy
            Set LWorkbook = ActiveWorkbook
            LFileName = LWorkbook.Worksheets(1).Name
            LWorkbook.SaveAs Filename:=LFileName
            
           .Body = "Bonjour," & vbCrLf _
           & vbCrLf _
           & "Vous trouverez ci joint votre fiche personnelle." & vbCrLf _
           & vbCrLf _
           & "Cordialement" & vbCrLf _
           & vbCrLf & vbCrLf _
           & "NOM PRENOM" ' Ton nom à mettre ici !
           
           .Attachments.Add LWorkbook.FullName
           .Display
           .Send
           
            LWorkbook.ChangeFileAccess Mode:=xlReadOnly
            Kill LWorkbook.FullName
            LWorkbook.Close SaveChanges:=False
            
        End With
        i = i + 1
    Loop While Sheets("Bilan").Range("A" & i).Value <> ""

End Sub 
 
ça fonctionne très bien chez moi mais il faut qu'Outlook soit ouvert sinon ça coince.

Ton fichier avec tout ce qui va bien est ici :
https://www.cjoint.com/c/EEysmjt4Pk2
1f u c4n r34d th1s u r34lly n33d t0 g37 l41d !

Nounours_Poilu · Answer

Merci Ozone_ tu es au top! 
Alors je n'ai pas encore pu tester ca (puisque pas Excel chez moi) mais je te tiendrai au jus si il y a un souci dès mardi.
Encore merci ;)

Nounours

Nounours_Poilu · Answer

Bonjour à tous, je reviens de nouveau vers vous car... mon service de messagerie n'est pas Outlook mais Mozilla Thunderbird et effectivement, ça coince. Par quelle commande dois-je déclarer Thunderbird ? Ca bug dès la ligne 3... 
D'avance merci et bonne journée ;)

Cordialement 
Nounours

Macro pour envoi d'un onglet par mail

5 réponses

Discussions similaires