Microsoft 365 Bouton : Envoi du classeur Excel par mail

Sylvain29

XLDnaute Nouveau
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
 
Solution
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...

Sylvain29

XLDnaute Nouveau
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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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" ?
 

Sylvain29

XLDnaute Nouveau
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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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 !
 

Statistiques des forums

Discussions
311 720
Messages
2 081 900
Membres
101 834
dernier inscrit
Jeremy06510