Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

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

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

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
 
Vote positif 0 Vote négatif

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
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
427
ph.vanne
S
  • Question
XL 2019 Envoi plusieurs pièces jointes
Réponses
1
Affichages
671
sylvanu
S
  • Question
XL 2019 Pièces jointes avec thunderbird
Réponses
7
Affichages
1 K
sylvanu
  • Question
XL 2019 Envoi Mail avec Destinataires dans Userform avec CheckBox (1 mail par destinataire)
2
Réponses
16
Affichages
1 K
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
  • Question
Microsoft 365 Envoi Mail Automatique avec Condition
Réponses
2
Affichages
706
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
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…