Microsoft 365 Bouton : Envoi du classeur Excel par mail

Sylvain29 · 18 Octobre 2021

Bonjour,
Je souhaite ajouter un bouton (VBA) pour envoyer par mail le classeur Excel.
J'ai essayé d'utiliser différentes macro, mais je ne parviens pas au résultat souhaité.

Le mail est envoyé toujours au même destinataire (c'est un formulaire)
Je souhaite le nommer exemple : "Ouverture de compte" & Range("E20")
Ajouter automatiquement un objet au mail, exemple : Ouverture de compte & Range("E20")
J'ai tenté la fonction Send Thisworkbook mais je ne parviens pas à obtenir le résultat que je souhaite.
A savoir : Une fois le formulaire complété, je clique sur le bouton, et ça ouvre le mail prêt à être envoyé avec le mail du destinataire complété ainsi que l'objet, un texte dans le mail et le classeur en pièce jointe. Ainsi l'utilisateur peut vérifier le mail avant envoi et y ajouter d'autre pièce jointe.
J'utilise déjà une macro qui correspond à mon besoin sauf que la pièce jointe est en PDF. Dois-je repartir de cette base ou faut-il repartir de zéro? Par avance merci pour votre aide !

VB:

Sub ENVOIMAIL1()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape
Dim sNomFic As String, sRep As String, WshShell As Object

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

' Créer une instance Windows Script pour retrouver le chemin du bureau
Set WshShell = CreateObject("WScript.Shell")
sRep = WshShell.SpecialFolders("Desktop")
Set WshShell = Nothing
' Définit le nom du fichier à enregistrer
sNomFic = Range("B15") & ".pdf"
' Enregistrer la feuille en PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & "\" & sNomFic, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Range("E20")
.CC = ""
.Attachments.Add (sRep & "\" & sNomFic)
.Subject = "DEVIS-" & Range("B15")
.body = Range("B110")
.display
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Kill (sRep & "\" & sNomFic)
End Sub

fanch55 · 21 Octobre 2021

Bonjour,
En parlant de Formulaire, que voulez-vous envoyer précisément ?

Une feuille ?
Un range ?

en pièce jointe ? ( donc via un fichier intermédiaire pdf ou autre )
en html dans le corps du mail ? ( donc pas de fichier intermédiaire )

Sylvain29 · 22 Octobre 2021

Bonjour,
je souhaite envoyer la feuille en format Excel, en pièce jointe dans un mail Outlook.
Et si possible (la où je rencontre une difficulté) sans que ça ouvre une boite de dialogue.
L'idéale étant que le mail outlook s'ouvre avant envoi (pour pouvoir y ajouter d'autres pièces jointes)

fanch55 · 22 Octobre 2021

A tester ( vous aviez bon ) :

VB:

Sub export_and_send()
Dim Fso As Object, OutApp As Object, OutMail As Object
Dim TmpFile As String
  
   ' nom temporaire fourni par le systeme
    Set Fso = CreateObject("Scripting.FileSystemObject")
        TmpFile = Environ("Temp") & "\" & Split(Fso.GetTempName(), ".")(0) & ".xlsx"
    Set Fso = Nothing
    
    ' Copie de la feuille dans un nouveau classeur
    Worksheets("Feuil2").Copy
    ActiveWorkbook.SaveAs Filename:=TmpFile, _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    
    Set OutApp = CreateObject("outlook.application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = Range("E20") ' <-- à corriger
        .CC = ""
        .Attachments.Add TmpFile
        .Subject = "DEVIS-" & Range("B15")  ' <-- à corriger
        .body = Range("B110")  ' <-- à corriger
        .display
    End With

    Kill TmpFile
End Sub

Sylvain29 · 25 Octobre 2021

fanch55 à dit:

A tester ( vous aviez bon ) :

VB:

Sub export_and_send()
Dim Fso As Object, OutApp As Object, OutMail As Object
Dim TmpFile As String
 
   ' nom temporaire fourni par le systeme
    Set Fso = CreateObject("Scripting.FileSystemObject")
        TmpFile = Environ("Temp") & "\" & Split(Fso.GetTempName(), ".")(0) & ".xlsx"
    Set Fso = Nothing
   
    ' Copie de la feuille dans un nouveau classeur
    Worksheets("Feuil2").Copy
    ActiveWorkbook.SaveAs Filename:=TmpFile, _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
   
    Set OutApp = CreateObject("outlook.application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = Range("E20") ' <-- à corriger
        .CC = ""
        .Attachments.Add TmpFile
        .Subject = "DEVIS-" & Range("B15")  ' <-- à corriger
        .body = Range("B110")  ' <-- à corriger
        .display
    End With

    Kill TmpFile
End Sub

Merci beaucoup @fanch55 , ça fonctionne ! j'ai juste modifié le format du fichier temporaire .xlsx en .xlsm ; et FileFormat:=xlOpenXMLWorkbook en xlOpenXMLWorkbookMacroEnabled.

Sylvain29 · 25 Octobre 2021

Merci pour votre précieuse aide !
Pour finaliser ma macro, afin qu'elle soit parfaite, la macro donne un nom quelquonque au fichier temporaire. Je pense que c'est ce nom qui est utilisé pour le coller dans le mail en pièce jointe. Le fichier à un nom nom du genre "rabB5C02", est-ce possible de li donner un nom fixe ? exemple "Ouverture" ?

fanch55 · 25 Octobre 2021

Bonjour,
Vous lui donnez le nom qui vous semble le mieux adapté.
Aucune adhérence au processus .
Par sécurité, détruisez le en début et en fin de processus :
If Dir(TmpFile) <> "" Then Kill TmpFile

Sylvain29 · 25 Octobre 2021

fanch55 à dit:
Bonjour,
Vous lui donnez le nom qui vous semble le mieux adapté.
Aucune adhérence au processus .
Par sécurité, détruisez le en début et en fin de processus :
If Dir(TmpFile) <> "" Then Kill TmpFile

Un énorme merci ! tout fonctionne parfaitement !

Sylvain29 · 26 Novembre 2021

Sylvain29 à dit:
Un énorme merci ! tout fonctionne parfaitement !

Bonjour @fanch55 , après quelques utilisation, de la macro, je rencontre un bloquage. Je pense que je n'ai pas bien intégré If Dir(TmpFile) <> "" Then Kill TmpFile. Pouvez-vous m'apporter votre aide? ou disposer ces lignes?

VB:

Sub export_and_send()
Dim Fso As Object, OutApp As Object, OutMail As Object
Dim TmpFile As String
 
   ' nom temporaire fourni par le systeme
    Set Fso = CreateObject("Scripting.FileSystemObject")
        TmpFile = ("OC D-") & Range("E20") & ".xlsm"
    Set Fso = Nothing
    
    ' Copie de la feuille dans un nouveau classeur
    Worksheets("Création Z001 Donneur d'ordre").Copy
    ActiveWorkbook.SaveAs Filename:=TmpFile, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWindow.Close
    
    Set OutApp = CreateObject("outlook.application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = ("credit.clients@hhh.fr") '
        .CC = ""
        .Attachments.Add TmpFile
        .Subject = "OC D-" & Range("E20")  '
        .body = "Bonjour, ci-joint ." '
        .display
    End With

    Kill TmpFile
End Sub

fanch55 · 26 Novembre 2021

Bonjour,

Tel que votre process est fait, il n'est pas utile de détruire le classeur créé .
Il faut juste dire à Excel de remplacer le classeur systématiquement sans demander de confirmation.
A moins que vous ne préfériez le détruire pour confidentialité .

J'attire quand même votre attention sur le fait
qu'un fichier Excel de type xlOpenXMLWorkbookMacroEnabled envoyé par mail
est susceptible d'être vidé/transformé pour raison de sécurité :

par votre réseau
par votre serveur de messagerie
par le serveur de messagerie du destinataire
par l'anti-virus du destinataire

La sub améliorée :

VB:

Sub export_and_send()
Dim ObjOutlook      As Object
Dim TmpFile         As String
Dim Outlook_Active  As Boolean

    TmpFile = Environ("Temp") & "\" & "OC D-" & Range("E20") & ".xlsm"
    
   ' Copie de la feuille dans un nouveau classeur
    Worksheets("Création Z001 Donneur d'ordre").Copy
  
   ' Sauvegarde du classeur sous un nom explicite
    Application.DisplayAlerts = False ' pour éviter le msg au remplacement du fichier
    ActiveWorkbook.SaveAs Filename:=TmpFile, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWindow.Close
    
   ' Envoi du nouveau classeur par mail Outlook
    On Error Resume Next
      ' On va déterminer si outlook est déjà ouvert pour ne pas le fermer sytématiquement
        Set ObjOutlook = GetObject(, "Outlook.Application")
        Outlook_Active = Not ObjOutlook Is Nothing
      ' Si outlook n'était pas ouvert, on l'ouvre
        If Not Outlook_Active Then Set ObjOutlook = CreateObject("Outlook.Application")
    On Error GoTo 0
    
    With ObjOutlook.CreateItem(0)
        .To = "credit.clients@hhh.fr"
        .CC = ""
        .Attachments.Add TmpFile
        .Subject = "OC D-" & Range("E20")
        .body = "Bonjour, ci-joint ."
        .display
    End With
      
    ' Si outlook n'était pas ouvert, on le quitte
    If Not Outlook_Active Then ObjOutlook.Quit
    Set ObjOutlook = Nothing
    
    If Dir(TmpFile) <> "" Then Kill TmpFile ' pour confidentialité

End Sub

Sylvain29 · 26 Novembre 2021

fanch55 à dit:
Bonjour,

Tel que votre process est fait, il n'est pas utile de détruire le classeur créé .
Il faut juste dire à Excel de remplacer le classeur systématiquement sans demander de confirmation.
A moins que vous ne préfériez le détruire pour confidentialité .

J'attire quand même votre attention sur le fait
qu'un fichier Excel de type xlOpenXMLWorkbookMacroEnabled envoyé par mail
est susceptible d'être vidé/transformé pour raison de sécurité :

par votre réseau

par votre serveur de messagerie

par le serveur de messagerie du destinataire

par l'anti-virus du destinataire

La sub améliorée :

VB:

Sub export_and_send() Dim ObjOutlook As Object Dim TmpFile As String Dim Outlook_Active As Boolean TmpFile = Environ("Temp") & "\" & "OC D-" & Range("E20") & ".xlsm" ' Copie de la feuille dans un nouveau classeur Worksheets("Création Z001 Donneur d'ordre").Copy ' Sauvegarde du classeur sous un nom explicite Application.DisplayAlerts = False ' pour éviter le msg au remplacement du fichier ActiveWorkbook.SaveAs Filename:=TmpFile, _ FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False ActiveWindow.Close ' Envoi du nouveau classeur par mail Outlook On Error Resume Next ' On va déterminer si outlook est déjà ouvert pour ne pas le fermer sytématiquement Set ObjOutlook = GetObject(, "Outlook.Application") Outlook_Active = Not ObjOutlook Is Nothing ' Si outlook n'était pas ouvert, on l'ouvre If Not Outlook_Active Then Set ObjOutlook = CreateObject("Outlook.Application") On Error GoTo 0 With ObjOutlook.CreateItem(0) .To = "credit.clients@hhh.fr" .CC = "" .Attachments.Add TmpFile .Subject = "OC D-" & Range("E20") .body = "Bonjour, ci-joint ." .display End With ' Si outlook n'était pas ouvert, on le quitte If Not Outlook_Active Then ObjOutlook.Quit Set ObjOutlook = Nothing If Dir(TmpFile) <> "" Then Kill TmpFile ' pour confidentialité End Sub

c'est parfait, merci beaucoup !

Effectuez une recherche sur Excel Downloads...

Microsoft 365 Bouton : Envoi du classeur Excel par mail

Sylvain29

XLDnaute Nouveau

fanch55

fanch55

XLDnaute Barbatruc

Sylvain29

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

Sylvain29

XLDnaute Nouveau

Sylvain29

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

Sylvain29

XLDnaute Nouveau

Sylvain29

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

Sylvain29

XLDnaute Nouveau

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums