[VBA] Excel > Outlook - Envoi mail

[lermite]

Envoyer un mail avec pièce jointe avec Outlook à partir d'un classeur excel

'Il faut activer la référence "Microsoft Outlook Library" Avant de lancer cette macro,
' Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook Library"
Sub Envoyer_Mail_Outlook()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String
   
    Set ObjOutlook = New Outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)
'---------------------------------------------------------
    'Exemple pour envoyer un classeur en pièce jointe
    'Nom_Fichier = Application.GetOpenFilename("Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
    'If Nom_Fichier = "Faux" Then Exit Sub
'---------------------------------------------------------
    'Ou bien entrer le path et nom du fichier autrement
    Nom_Fichier = "C:\Chemin\NomFichier.ext"
    If Nom_Fichier = "" Then Exit Sub
'---------------------------------------------------------
      With oBjMail
        .To = "LeClient@gmail.com" ' le destinataire
        .Subject = "Ici c'est l'objet"          ' l'objet du mail
        .Body = "Ici le texte du mail "  'le corps du mail ..son contenu
        .Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
        .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
        .Send
    End With
    ObjOutlook.Quit
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
End Sub

[Megatronnbjja]

Bonjour,

Très bien détaillée et très bien expliquée cette procédure, chapeau!
Est-il possible pour la ligne .Body de mettre un copier/coller d'une plage du tableur? avec la mise en forme et tout...
J'ai essayé .Body = Range("A1:E10").Value mais ça ne fonctionne pas. Merci

[lermite]

Bonjour,
Il y a moyen de mettre un tableau dans le corps du message mais tout le corps doit être formater en HTLM, pour cela tu dois connaître les balises et la façon de l'organiser.
Tu peu avoir une idée sur le site de MS http://support.microsoft.com/default.aspx?kbid=286430
A+
EDIT: Possible que le HTLM soit accepter par Outlook mais je n'ai pas testé, sinon il faudrait employé le modèle CDO voir ce lien

[Megatronnbjja]

RE,
Merci bien pour ton aide, par contre, j'ai essayé de comprendre le fonctionnement de la macro proposé mais je suis très très vite perdu.
Je ne sais même pas ce qu'est le PICKUP DIRECTORY.
impossible pour moi d'utiliser le code tel quel puisqu'il fut que j'explique tout ça à mon responsable par la suite.

Si, par pur miracle, tu avais le temps de regarder le code et de me donner une explication, même succincte, par ligne... je serais ravi.

sinon merci encore.

[lermite]

Re,
Même si je documentais l'exemple en français je pense que tu n'y comprendrais rien et de plus il faudrait y ajouter des lignes.
Le plus simple pour toi serait de mettre le tableau en pièce jointe. Là je pourrais t'aider un peu plus dans tes compétences.

[lienlien34]

Bonjour tout le monde,

Merci lermite pour ta macro, elle marche au top et elle est super détaillée ! Par contre pourrais-tu me dire comment virer le message de confirmation d'outlook ?

[lermite]

Bonjour,
@ lienlien34
Le code ne demande pas de confirmation.
Supprime cette fonction dans les propriétés d'Outlook.
A+

[lienlien34]

Re lermite,

J'ai implantée ton code dans une de mes macros qui doit envoyer un mail à diverses personnes avec en pièce jointe un classeur excel qui les concerne.

Bon alors je n'ai pas trouvé l'option pour virer le message de confirmation d'envoie :/ mais en plus les mails ne s'envoient pas, ils restent coincés dans la boîte d'envoie. Je suis obligé d'ouvrir outlook, aller dans la boîte d'envoi et quand je veux ermer outlook, il me demande si je veux bien fermer outlook alors que des mails n'ont pas été envoyé. Je réponds que non, donc ne pas fermer outlook et apres et seulement apres les mails finissent par s'envoyer.... T'aurais une petite idée ?? Désolé de te déranger avec ça mais je bloque dessus depuis quelques heures déjà :/

[lermite]

Re,
Pour envoyer à plusieurs personnes tu à modifié le code.. met le dans un poste suivant.
EDIT :
Dans les options il y a une propriété avec envoi silencieux.. (me rappel pas les termes exact) tu décoche.

[lienlien34]

Merci lermite de me proposer ton aide, tiens regarde mon code. Je crée 5 fichiers et si une condition est remplie dans dans chaque feuille, alors je crée un nouveau classeur et j'envoie le mail. Merci encore

Sub split()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim r As Integer, i As Integer, AW As String


''''''''''''''''''''''''''''''''''''''''''
''''' pour envoyer mail
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String, Nom_Fichier1 As String, Nom_Fichier2 As String, Nom_Fichier3 As String, Nom_Fichier4 As String


''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''

Dim classeurSource As Workbook, classeurDestinationGW As Workbook
Set classeurSource = ThisWorkbook
Set classeurDestinationGW = Application.Workbooks.Open("U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\TEMPLATES\GéraldineWersy.xlsx", , True)          'définir le classeur source et son chemin
Set classeurDestinationGDN = Application.Workbooks.Open("U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\TEMPLATES\GhislaindeNazelle.xlsx", , True)          'définir le classeur source et son chemin
Set classeurDestinationBM = Application.Workbooks.Open("U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\TEMPLATES\BrunoMouton.xlsx", , True)          'définir le classeur source et son chemin
Set classeurDestinationEDG = Application.Workbooks.Open("U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\TEMPLATES\EmmanuelDurandGasselin.xlsx", , True)          'définir le classeur source et son chemin
Set classeurDestinationAJ = Application.Workbooks.Open("U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\TEMPLATES\AntoineJardet.xlsx", , True)          'définir le classeur source et son chemin



''----------------------------------CREATE FILE "GW"----------------------------------

classeurSource.Activate
Sheets("GW").Select
If Cells(2, 1) <> "" Then
ActiveSheet.Calculate
r = Range("G1").End(xlDown).Row
Range("A1:G" & r).Copy


classeurDestinationGW.Activate
Sheets("GW").Select
Range("A1").PasteSpecial xlPasteValues



ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & "Géraldine Wersy_" & Format(Date, "dd-mm-yyyy") & ".xlsx"

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

Nom_Fichier = "U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\Géraldine Wersy.xlsx"


Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

Nom_Fichier = "U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\Géraldine Wersy.xlsx"

With oBjMail
        .To = "a.gerant@blabla.fr" ' le destinataire
       .Subject = "Ici c'est l'objet"          ' l'objet du mail
       .Body = "Ici le texte du mail "  'le corps du mail ..son contenu
       .Attachments.Add "U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\Géraldine Wersy_" & Format(Date, "dd-mm-yyyy") & ".xlsx"
       .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
       .Send
    End With
    
    ObjOutlook.Quit
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
    
    
Else: classeurDestinationGW.Close False
End If
'---------------------------------------------------------------------------------------

''----------------------------------CREATE FILE "GDN"----------------------------------
classeurSource.Activate

Sheets("GDN").Select
ActiveSheet.Calculate
If Cells(2, 1) <> "" Then
r = Range("G1").End(xlDown).Row
Range("A1:G" & r).Copy

classeurDestinationGDN.Activate
Sheets("GDN").Select
Range("A1").PasteSpecial xlPasteValues

ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & "Ghislain de Nazelle_" & Format(Date, "dd-mm-yyyy") & ".xlsx"

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

Nom_Fichier1 = "U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\Ghislain de Nazelle.xlsx"

With oBjMail
        .To = "a.gerant@blabla.fr" ' le destinataire
       .Subject = "Ici c'est l'objet"          ' l'objet du mail
       .Body = "Ici le texte du mail "  'le corps du mail ..son contenu
       .Attachments.Add "U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\Ghislain de Nazelle_" & Format(Date, "dd-mm-yyyy") & ".xlsx"
       .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
       .Send
    End With
    
    ObjOutlook.Quit
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
    
    

Else: classeurDestinationGDN.Close False
End If

''---------------------------------------------------------------------------------------
'
''----------------------------------CREATE FILE "BM"----------------------------------
classeurSource.Activate

Sheets("BM").Select
If Cells(2, 1) <> "" Then
ActiveSheet.Calculate
r = Range("G1").End(xlDown).Row
Range("A1:G" & r).Copy

classeurDestinationBM.Activate
Sheets("BM").Select
Range("A1").PasteSpecial xlPasteValues

ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & "Bruno Mouton_" & Format(Date, "dd-mm-yyyy") & ".xlsx"

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

Nom_Fichier2 = "U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\Bruno Mouton.xlsx"

With oBjMail
        .To = "a.gerant@blabla.fr" ' le destinataire
       .Subject = "Ici c'est l'objet"          ' l'objet du mail
       .Body = "Ici le texte du mail "  'le corps du mail ..son contenu
       .Attachments.Add "U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\Bruno Mouton_" & Format(Date, "dd-mm-yyyy") & ".xlsx"
       .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
       .Send
    End With
    
    ObjOutlook.Quit
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
    
    
Else: classeurDestinationBM.Close False
End If

''---------------------------------------------------------------------------------------
'
''----------------------------------CREATE FILE "EDG"----------------------------------
classeurSource.Activate

Sheets("EDG").Select
ActiveSheet.Calculate
If Cells(2, 1) <> "" Then
r = Range("G1").End(xlDown).Row
Range("A1:G" & r).Copy

classeurDestinationEDG.Activate
Sheets("EDG").Select
Range("A1").PasteSpecial xlPasteValues

ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & "Emmanuel Durand Gasselin_" & Format(Date, "dd-mm-yyyy") & ".xlsx"

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

Nom_Fichier3 = "U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\Emmanuel Durand Gasselin.xlsx"

With oBjMail
        .To = "a.gerant@blabla.fr" ' le destinataire
       .Subject = "Ici c'est l'objet"          ' l'objet du mail
       .Body = "Ici le texte du mail "  'le corps du mail ..son contenu
       .Attachments.Add "U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\Emmanuel Durand Gasselin_" & Format(Date, "dd-mm-yyyy") & ".xlsx"
       .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
       .Send
    End With
    
    ObjOutlook.Quit
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
    
    
Else: classeurDestinationEDG.Close False
End If

''---------------------------------------------------------------------------------------
'
''----------------------------------CREATE FILE "AJ"----------------------------------
classeurSource.Activate

Sheets("AJ").Select
ActiveSheet.Calculate
If Cells(2, 1) <> "" Then
r = Range("G1").End(xlDown).Row
Range("A1:G" & r).Copy

Workbooks.Open ThisWorkbook.Path & "\TEMPLATES\" & "Antoine Jardet_TEMPLATE.xls", , True
Sheets("AJ").Select
Range("A1").PasteSpecial xlPasteValues

ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & "Antoine Jardet_" & Format(Date, "dd-mm-yyyy") & ".xlsx"

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

Nom_Fichier4 = "U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\Antoine Jardet.xlsx"

With oBjMail
        .To = "a.gerant@blabla.fr" ' le destinataire
       .Subject = "Ici c'est l'objet"          ' l'objet du mail
       .Body = "Ici le texte du mail "  'le corps du mail ..son contenu
       .Attachments.Add "U:\Contrôles\Quotidiens\Contrôle du Niveau Espèces\Aurélien\Antoine Jardet_" & Format(Date, "dd-mm-yyyy") & ".xlsx"
       .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
       .Send
    End With
    
ObjOutlook.Quit
Set oBjMail = Nothing
Set ObjOutlook = Nothing
    
    

Else: classeurDestinationAJ.Close False
End If

''---------------------------------------------------------------------------------------




Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub