Macro Envoyer chaque feuille par email

[sive91]

Bonjour,
j'ai modifié une macro pour envoyer par email l'ensemble des feuilles d'un classeur :
deux problèmes:
_ le premier : Un message apparaît me précisant : un programme tente d'envoyer un message en votre nom
j'ai donc fait une petite recherche, et en lançant Outlook en administrateur, j'ai modifier les paramètres précisant de ne plus afficher ces notifications, et pourtant cela continue.

_Le second : une fois les mails envoyés le script plante : erreur d'execution 1004
La methode Copy de l'objet _Worksheet à echouée


_Bonus, si par hasard vous saviez comment eviter l'envoie de ma premiere feuille nommée Entete ^^

Merci par avance


Private Sub CommandButton2_Click()
Dim Wsh As Worksheet

Application.ScreenUpdating = False
For Each Wsh In ThisWorkbook.Worksheets
Wsh.Copy
With ActiveWorkbook
.SendMail Recipients:=Wsh.Range("F11"), Subject:="Commande"
.Close False
End With
Next
Application.ScreenUpdating = True
MsgBox "Envoi des mails terminé"
End Sub

 

[sive91]

Merci je vais tester, je suis en version 2016

 

[sive91]

On Error Resume Next
Application.DisplayAlerts = False
est deja présent dans mon script
Private Sub CommandButton2_Click()
Dim Chemin As String, Fichier As String, Corps As String, Nom As String
Dim OlApp As Object, Wsh As Worksheet, cel As Range, Rep_Xl, 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

On Error Resume Next
Application.DisplayAlerts = False

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 notre commande." _
& vbLf & vbLf & "Cordialement," & vbLf & vbLf & vbLf & ""

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

Rep_Xl = Dir(Chemin & "*.xls")
Do While Rep_Xl <> ""
Kill Chemin & Rep_Xl
Rep_Xl = Dir
Loop
Feuil1.Activate
End Sub

 

[Lone-wolf]

Re

OK, mais cette fois c'est bon ou pas??