VBA, envoi mail avec 2 pieces jointe

Bonjour a tous

Je viens pour une premiere pub demander votre aide pour automatiser l'envoi d'un mail via outlook a partir d'excel.

J'aimerais, en cliquant sur un bouton envoyer un mail, a plusieurs personne avec 2 pieces jointe dispo sur mon disque dur et un corps de message.

En esperant avoir une proposition je vous souhaite bonne année 2019.

Hello,

Le mieux serait d'avoir ton fichier test avec la dénomination exacte, les noms de tes fichiers à joindre, l'emplacement etc ...

Ce mail sera-t-il envoyé toujours aux mêmes personnes ?

Un corps de message est-il nécessaire ?

On peu faire plein de chose mais il faut les infos nécessaires

Bonne année à toi aussi !

Bonjour Ergotamine

Merci pour l'interet. Ci joint un fichier representatif.

19rapport.xlsm (12.60 Ko)

Le mail sera envoyer envoyé aux meme personnes selon la liste d'adresse en feuille "adress". Cette liste sera limitée a 10 adresse.

Un corps de message est souhaitable.

Merci d'avance

Bonjour,

si en attendant cela peut aider:

vu ici Youtube ici merci à Romulad

Sub envoiMail()
Dim fichiers as Variant
On Error Goto plouf
fichiers = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")

MsgBox fichiers  ' msgbox facultatif mais conseillé
Dim mypost, myCourriel As Object

Set mypost = CreateObject("Outlook Application")
Set myCourriel = mypost.CreateItem(0)
myCourriel.To = "testexcel@excel.fr" 
' myCourriel.CC = "testexcel@excel.fr"  

myCourriel.Attachments.Add fichiers
myCourriel.Subject="TEST MAIL par Pièce jointe"           ' on modifie ici

contient ="Bonne année 2019, "
contient = contient & Chr(10) & Chr(13)
contient = contient & "Ci-joint le doc, passez une agréable heureuse année 2019."
myCourriel.Body = contient
myCourriel.Send
Set mypost = Nothing
MsgBox " Envoyé avec Succès!"

plouf:
MsgBox "Erreur !!!"
End Sub

crdlt,

André

Re,

Ton code :

Sub Envoi()

Dim olmail As MailItem
Dim Destinataires As String

For i = 1 To Worksheets("Adress mail").Range("A" & Rows.Count).End(xlUp).Row
    Destinataires = Destinataires & ";" & Worksheets("Adress mail").Range("A" & i).Value
Next i

Set App = New Outlook.Application
Set olmail = App.CreateItem(olMailItem)
    With olmail
     .To = Destinataires
     .Subject = "Rapport du mois"
     .Body = "Bonjour," & Chr(10) & Chr(10) & "Veuillez trouver ci-joint le rapport du mois"
     .Attachments.Add "C:\Rapport\decembre.xlsx"
     .Attachments.Add "C:\Rapport\decembre.pdf"
     .Display '.Send     'On peut switcher entre .send et .display selon que l'on veut envoyer le mail (send) ou seulement le préparer et le vérifier(display)
    End With
End Sub

A noter qu'il est possible d'automatiser les envois des pièces jointes, par exemple en précisant le nom du mois à envoyer sur ton fichier qui ira directement le chercher dans le répertoire.

PS : Il faut que tu actives les références outlook dans ton éditeur VBA pour que la macro fonctionne : ALT + F11 --> Outils --> Références --> Microsoft Outlook Object Librabry

Cordialement,

Merci à vous.

Ergotamine ca marche, merci.

Comment devrais je proceder pour automatiser l'envoi du message chaque mois?

Hello,

Un exemple.

Ainsi si dans ton répertoire rapport tu appelles tes fichiers :

2018_decembre.xslx et 2018_decembre.pdf, que tu mets 2018 en A1 et decembre en A2, il devrait récupérer les bons fichiers.

Je te conseille même de mettre 2018_12.xslx et 2018_12.pdf pour pouvoir profiter du classement simplifié dans ton dossier rapport (dans ce cas modifie la liste de validation sur l'excel joint).

Tu as compris la logique ?

Bonne soirée !

12rapport.xlsm (21.88 Ko)

Ok, oui je comprend la logique , je teste et je te reviens.

Merci encore

J'ai du corriger le code, j'avais fait des erreurs de débutant :

Sub Envoi()

Dim olmail As MailItem
Dim Destinataires As String
Dim Mois As String
Dim Annee As String

Annee = Worksheets("Feuil1").Range("B1").Value
Mois = Worksheets("Feuil1").Range("B2").Value
For i = 1 To Worksheets("Adress mail").Range("A" & Rows.Count).End(xlUp).Row
    Destinataires = Destinataires & ";" & Worksheets("Adress mail").Range("A" & i).Value
Next i

On Error GoTo Erreur

Set App = New Outlook.Application
Set olmail = App.CreateItem(olMailItem)
    With olmail
     .To = Destinataires
     .Subject = "Rapport du mois"
     .Body = "Bonjour," & Chr(10) & Chr(10) & "Veuillez trouver ci-joint le rapport du mois"
     .Attachments.Add "C:\Rapport\" & Annee & "_" & Mois & ".xlsx"
     .Attachments.Add "C:\Rapport\" & Annee & "_" & Mois & ".pdf"
     .Display '.Send     'On peut switcher entre .send et .display selon que l'on veut envoyer le mail (send) ou seulement le préparer et le vérifier(display)
    End With
Exit Sub

Erreur:
MsgBox "Une erreur s'est produite, mail non généré", vbCritical

End Sub

J'y ai ajouté une msgbox en cas d'erreur.

Salut Ergotamine

J'ai essayé ca marche du tonerre.

Merci

Rechercher des sujets similaires à "vba envoi mail pieces jointe"