XL 2016 Envoi pièce jointe par mail

S

SALAH

XLDnaute Occasionnel
Bonjour le forum

Je reviens vers vous car j' avais posté une discussion concernant l' envoi de mail avec pièce jointe en pdf.

Serait il possible que vous m' aidiez à utiliser le même code qui marche parfaitement mais au lieu d' avoir le fichier en pdf il serait en xls

En fait je m' explique, j' aimerais créer un mail et envoyer l' onglet du classeur en xls

Ci-joint le code ci-dessous à remodifier

Merci à vous tous

Private Sub CommandButton2_Click()
Dim destinataire, sujet, fichierjoint As String
destinataire = "cerise@free.fr"
sujet = "Fichier " & Range("D9").Value

Sheets("Sheet1").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ActiveWorkbook.Path & "\" & "Sheet1.pdf"

text1 = " Bonjour " & "<br>"
text2 = "<br>"
text3 = " Je te prie de trouver ci-joint le fichier en pdf " & "<br><br>"
text4 = "Bien Cordialement" & "<br><br>"
text5 = "Salah" & "<br><br>"
text6 = "Tél.: 01-45-23-12-11"

Body = text1 & text2 & text3 & text4 & text5 & text6


fichierjoint = "C:\Users\Salah\Desktop\donnees\Sheet1.xls"

strcommand = "C:\Program Files (x86)\Mozilla Thunderbird\Thunderbird.exe"
strcommand = strcommand & " -compose " & "to='" & destinataire & "'"
strcommand = strcommand & "," & "subject=" & sujet & ","
strcommand = strcommand & "body=" & Body
strcommand = strcommand & "," & "attachment=file:///" & fichierjoint
'MsgBox strcommand

Call Shell(strcommand, vbNormalFocus)

End Sub
 
Trier par date Trier par votes
xUpsilon

xUpsilon

XLDnaute Accro
Bonjour,

Si ton fichier est déjà présent avec le nom "Sheet1.xls" dans le dossier "donnees" alors je pense qu'il te suffit de supprimer la ligne qui s'occupe d'imprimer ton excel en pdf.
Par contre un truc me titille, pourquoi fichierjoint est déjà Sheet1.xls ? Tu dis pourtant envoyer un pdf à l'heure actuelle ?

Bonne continuation
 
Vote positif 0 Vote négatif
S

SALAH

XLDnaute Occasionnel
Bonjour le forum, xUpsilon

En fait c' est une erreur c'est .pdf et non .xls

Je joins le ficher pour une meilleur compréhension
Ce qui m' intéresse le plus c' est d' avoir la pièce jointe en .xls

Merci
 

Pièces jointes

  • Application.xlsm
    29.5 KB · Affichages: 22
Vote positif 0 Vote négatif
Sequoyah

Sequoyah

XLDnaute Nouveau
Bonjour Salah et le forum,
une solution à tester:
VB: 
Private Sub CommandButton2_Click()

    Dim NewWbk    As Workbook
    Dim destinataire As String, Sujet As String, Message As String
    Dim FilePath As String, FileName As String

    destinataire = "cerise@free.fr"
    FilePath = Environ$("temp") & "\"
    Sujet = "Fichier " & ThisWorkbook.Sheets(1).Range("D9").Value
        
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    ActiveSheet.Copy
    
    Set NewWbk = ActiveWorkbook
    
    With NewWbk
        FileName = .Sheets(1).Name
        .SaveAs FilePath & FileName, FileFormat:=51 '56 pour xls
    End With
    
    PieceJointe = NewWbk.FullName
    
    text1 = " Bonjour " & "<br>"
    text2 = "<br>"
    text3 = " Je te prie de trouver ci-joint le fichier......." & "<br><br>"
    text4 = "Bien Cordialement" & "<br><br>"
    text5 = "Salah" & "<br><br>"
    text6 = "Tél.: 01-45-23-12-11"
    
    Message = text1 & text2 & text3 & text4 & text5 & text6
    
   strcommand = "C:\Program Files (x86)\Mozilla Thunderbird\Thunderbird.exe"
   strcommand = strcommand & " -compose " & "to= '" & destinataire & "'"
   strcommand = strcommand & "," & "subject=" & Sujet & ","
   strcommand = strcommand & "body=" & Message
   strcommand = strcommand & "," & "attachment=" & PieceJointe
    
    Call Shell(strcommand, vbNormalFocus)
    
    NewWbk.Close
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub
 
Vote positif 0 Vote négatif
S

SALAH

XLDnaute Occasionnel
Bonjour le forum, Sequoyah, xUpsilon

Sa marche à merveille Sequoyah, exactement ce que je veux
sinon une autre précision si cela ne te dérange pas serait il possible que la pièce jointe porte le même nom que la cellule D9,?
En te remerciant par avance
 
Dernière édition:
Vote positif 0 Vote négatif
Sequoyah

Sequoyah

XLDnaute Nouveau
Bonjour Salah,
merci pour ton retour. J'espère ne pas avoir mal compris, si le nom de l'onglet est dans la cellule D9, la feuille correspondante est copiée. J'ai aussi ajouté le code pour supprimer les boutons de la copie du fichier. Voici le code corrigé:
VB: 
Private Sub CommandButton2_Click()
'https://www.excel-downloads.com/threads/envoi-piece-jointe-par-mail.20038977/

    Dim NewWbk    As Workbook
    Dim destinataire As String, Sujet As String, Message As String, Feuille As String
    Dim FilePath As String, FileName As String
    Dim btn As Shape

    destinataire = "cerise@free.fr"
    FilePath = Environ$("temp") & "\"
    Sujet = "Fichier " & ThisWorkbook.Sheets(1).Range("D9").Value
    Feuille = ThisWorkbook.Sheets(1).Range("D9").Value
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Sheets(Feuille).Copy
    
    Set NewWbk = ActiveWorkbook
    
    With NewWbk
        FileName = .Sheets(1).Name
                
        For Each btn In ActiveSheet.Shapes
            If btn.AutoShapeType = msoShapeStyleMixed Then btn.Delete
        Next
                
        .SaveAs FilePath & FileName, FileFormat:=51 '56 pour xls
    End With
    
    PieceJointe = NewWbk.FullName
    
    text1 = " Bonjour " & "<br>"
    text2 = "<br>"
    text3 = " Je te prie de trouver ci-joint le fichier......." & "<br><br>"
    text4 = "Bien Cordialement" & "<br><br>"
    text5 = "Salah" & "<br><br>"
    text6 = "Tél.: 01-45-23-12-11"
    
    Message = text1 & text2 & text3 & text4 & text5 & text6
    
    strcommand = "C:\Program Files (x86)\Mozilla Thunderbird\Thunderbird.exe"
    strcommand = strcommand & " -compose " & "to= '" & destinataire & "'"
    strcommand = strcommand & "," & "subject=" & Sujet & ","
    strcommand = strcommand & "body=" & Message
    strcommand = strcommand & "," & "attachment=" & PieceJointe
    
    Call Shell(strcommand, vbNormalFocus)
    
    NewWbk.Close
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub
 
Vote positif 0 Vote négatif
S

SALAH

XLDnaute Occasionnel
Sequoyah à dit:
Bonjour Salah,
merci pour ton retour. J'espère ne pas avoir mal compris, si le nom de l'onglet est dans la cellule D9, la feuille correspondante est copiée. J'ai aussi ajouté le code pour supprimer les boutons de la copie du fichier. Voici le code corrigé:
VB: 
Private Sub CommandButton2_Click()
'https://www.excel-downloads.com/threads/envoi-piece-jointe-par-mail.20038977/

    Dim NewWbk    As Workbook
    Dim destinataire As String, Sujet As String, Message As String, Feuille As String
    Dim FilePath As String, FileName As String
    Dim btn As Shape

    destinataire = "cerise@free.fr"
    FilePath = Environ$("temp") & "\"
    Sujet = "Fichier " & ThisWorkbook.Sheets(1).Range("D9").Value
    Feuille = ThisWorkbook.Sheets(1).Range("D9").Value
   
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
    End With
   
    Sheets(Feuille).Copy
   
    Set NewWbk = ActiveWorkbook
   
    With NewWbk
        FileName = .Sheets(1).Name
               
        For Each btn In ActiveSheet.Shapes
            If btn.AutoShapeType = msoShapeStyleMixed Then btn.Delete
        Next
               
        .SaveAs FilePath & FileName, FileFormat:=51 '56 pour xls
    End With
   
    PieceJointe = NewWbk.FullName
   
    text1 = " Bonjour " & "<br>"
    text2 = "<br>"
    text3 = " Je te prie de trouver ci-joint le fichier......." & "<br><br>"
    text4 = "Bien Cordialement" & "<br><br>"
    text5 = "Salah" & "<br><br>"
    text6 = "Tél.: 01-45-23-12-11"
   
    Message = text1 & text2 & text3 & text4 & text5 & text6
   
    strcommand = "C:\Program Files (x86)\Mozilla Thunderbird\Thunderbird.exe"
    strcommand = strcommand & " -compose " & "to= '" & destinataire & "'"
    strcommand = strcommand & "," & "subject=" & Sujet & ","
    strcommand = strcommand & "body=" & Message
    strcommand = strcommand & "," & "attachment=" & PieceJointe
   
    Call Shell(strcommand, vbNormalFocus)
   
    NewWbk.Close
   
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = True
        .EnableEvents = True
    End With
   
End Sub
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Sequoyah

Sequoyah

XLDnaute Nouveau
Bonjour Salah et le forum:),
je n’avais pas bien compris ta demande, la solution est encore plus simple, voici le code adapté:
VB: 
Private Sub CommandButton2_Click()

    Dim NewWbk    As Workbook
    Dim destinataire As String, Sujet As String, Message As String
    Dim FilePath As String, FileName As String

    destinataire = "cerise@free.fr"
    FilePath = Environ$("temp") & "\"
    Sujet = "Fichier " & ThisWorkbook.Sheets(1).Range("D9").Value
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    ActiveSheet.Copy
    
    Set NewWbk = ActiveWorkbook
    
    With NewWbk
        FileName = .Sheets(1).Range("D9").Value
        
        For Each btn In ActiveSheet.Shapes
            If btn.AutoShapeType = msoShapeStyleMixed Then btn.Delete
        Next
        .SaveAs FilePath & FileName, FileFormat:=51 '56 pour xls
    End With
    
    PieceJointe = NewWbk.FullName
    
    text1 = " Bonjour " & "<br>"
    text2 = "<br>"
    text3 = " Je te prie de trouver ci-joint le fichier......." & "<br><br>"
    text4 = "Bien Cordialement" & "<br><br>"
    text5 = "Salah" & "<br><br>"
    text6 = "Tél.: 01-45-23-12-11"
    
    Message = text1 & text2 & text3 & text4 & text5 & text6
    
    strcommand = "C:\Program Files (x86)\Mozilla Thunderbird\Thunderbird.exe"
    strcommand = strcommand & " -compose " & "to= '" & destinataire & "'"
    strcommand = strcommand & "," & "subject=" & Sujet & ","
    strcommand = strcommand & "body=" & Message
    strcommand = strcommand & "," & "attachment=" & PieceJointe
    
    Call Shell(strcommand, vbNormalFocus)
    
    NewWbk.Close
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

ph.vanne
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
427
ph.vanne
ph.vanne
S
  • Question
XL 2019 Envoi plusieurs pièces jointes
Réponses
1
Affichages
670
sylvanu
sylvanu
S
  • Question
XL 2019 Pièces jointes avec thunderbird
Réponses
7
Affichages
1 K
sylvanu
sylvanu
ELSONCe
  • Question
XL 2019 Envoi Mail avec Destinataires dans Userform avec CheckBox (1 mail par destinataire)
2
Réponses
16
Affichages
1 K
Oneida
Oneida
M
  • Résolu(e)
XL 2016 envoi de mail en automatique en fonction de plusieurs menus deroulants
2
Réponses
26
Affichages
2 K
mathieu20
M
ELSONCe
  • Question
Microsoft 365 Envoi Mail Automatique avec Condition
Réponses
2
Affichages
706
ELSONCe
ELSONCe
C
  • Question
XL 2019 Envoi mail : Condition dans un HTMLBODY
Réponses
2
Affichages
700
Cheyenne_2021
C
B
  • Question
Microsoft 365 Envoi pièce jointe html avec Outlook en VBA
Réponses
5
Affichages
1 K
bennp
B
G
  • Question
Envoi mail avec pièce jointe
Réponses
2
Affichages
1 K
Gwendoline
G
S
  • Question
Autres envoi fichier en pièce jointe par mail
Réponses
1
Affichages
1 K
Compte Supprimé 979
C

Membres actuellement en ligne

23 membres et 231 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 103
Messages
2 116 249
Membres
112 696
dernier inscrit
MagideDupont