Option Explicit
Sub Envoi_Mail()
Dim Chemin As String, Fichier As String, Corps As String, Nom As String
Dim OlApp As Object, Wsh As Worksheet, cel As Range, Rep_Xls, EnvoisA, OlMail
Chemin = ThisWorkbook.Path & "\"
For Each Wsh In Worksheets
Wsh.Activate
EnvoisA = Wsh.[F11]
Set cel = Wsh.[B13] 'Nom du nouveau classeur
Nom = cel.Value
Wsh.Copy
ActiveSheet.SaveAs Filename:=Chemin & Nom & ".xls", FileFormat:=xlExcel8, CreateBackup:=False
ActiveWorkbook.Close True
Set OlApp = CreateObject("Outlook.Application")
Set OlMail = OlApp.CreateItem(0)
Fichier = ThisWorkbook.Path & "\" & Nom & ".xls"
Corps = "Bonjour Mesdames, Messieurs," & vbLf & "Recevez en pièce jointe votre commande." _
& vbLf & vbLf & "Cordialement" & vbLf & vbLf & vbLf & "Sive"
With OlMail
.To = EnvoisA 'Envoyer à
.Subject = "Commande" 'Sujet
' .BCC = "" 'Envoi en copie cachée
.Body = Corps 'Corps du message
.Attachments.Add Fichier 'Fichier en pièce jointe
.Display
'.Send 'Envoi direct
End With
'OlApp.Quit
Set OlMail = Nothing
Set OlApp = Nothing
Next Wsh
On Error Resume Next
Application.DisplayAlerts = False
Rep_Xls = Dir(Chemin & "*.xls")
Do While Rep_Xls <> ""
Kill Chemin & Rep_Xls
Rep_Xls = Dir
Loop
Feuil1.Activate
End Sub