Macro Envoyer chaque feuille par email

S

sive91

XLDnaute Junior
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
 
Trier par date Trier par votes
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Bonjour sive

tu dis: pour envoyer par email l'ensemble des feuilles d'un classeur.

Dans ce cas, pourquoi ne pas envoyer juste le classeur; parce-que je ne vois pas l'intérêt d'envoyer 3 ou 5 feuilles. À moins que chaque feuille est reservée à chaque personne. Feuil1 à M. X, Feuil2 à Mme Y. etc.

Avec .SendMail Recipients, c'est tout à fait normal d'avoir le message d'alerte. Excel considère celà comme pièce dangereuse. Personnellement je préfère passer par une macro Outlook.

Voici la macro à adapter à ton cas

VB: 
Option Explicit

Sub Envoi_Mail()
Dim Fichier As String
Dim OlApp As Object
Dim OlMail

    Fichier = ThisWorkbook.Path & "\Classeur1.xlsx"

    Set OlApp = CreateObject("Outlook.Application")
    Set OlMail = OlApp.CreateItem(0)
    With OlMail
        .To = ""      'Envoyer à
        .Subject = ""         'Sujet
        ' .BCC = ""          'Envoi en copie cachée
        .Body = ""           'Corps du message
        .Attachments.Add Fichier    'Fichier en pièce jointe
        .Display
        '.Send    'Envoi direct
    End With
    Set OlMail = Nothing
    Set OlApp = Nothing
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
S

sive91

XLDnaute Junior
Merci Lone-Wolf, peux tu m'aider à l'intégrer à mon bouton s'il te plait
Option Explicit
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 & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close True


Set OlApp = CreateObject("Outlook.Application")
Set OlMail = OlApp.CreateItem(0)

Fichier = ThisWorkbook.Path & "\" & Nom & ".xlsx"
Corps = "Bonjour Mesdames, Messieurs," & vbLf & "Recevez en pièce jointe votre 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 & "*.xlsx")
Do While Rep_Xl <> ""
Kill Chemin & Rep_Xl
Rep_Xl = Dir
Loop
Entete.Activate
End Sub
 
Vote positif 0 Vote négatif
S

sive91

XLDnaute Junior
En effet, bon j'avais un peu trop modifié ^^
Option Explicit
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 & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close True


Set OlApp = CreateObject("Outlook.Application")
Set OlMail = OlApp.CreateItem(0)

Fichier = ThisWorkbook.Path & "\" & Nom & ".xlsx"
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 & "*.xlsx")
Do While Rep_Xl <> ""
Kill Chemin & Rep_Xl
Rep_Xl = Dir
Loop
Feuil1.Activate
End Sub


Dis moi actuellement il me propose l'enregistrement de classeur1 puis il ouvre le nombre de mail correspondant aux feuilles, peut on automatiser cet enregistrement et les envois ?
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Bonjour sive :), le Forum :)

Le message s'affiche par-ce que on l'enregistre au format .xlsx(format qui ne prend pas en charge les macros). J'ai modifier l'extension en .xls, là tu ne devrais plus avoir de message de confirmation d'enregistrement.

VB: 
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
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re

Est-ce que tu as changé l'extension .xlsx par xls?? As-tu bien regardé ma dernière macro??. Si oui, tu ne devrais pas avoir ce message. Sinon il faut aller dans les options > centre de gestion de confidentialité > paramètres > barre de messages et coché la dernière case. Paramètres des macros > cocher Accès appprouvé ....
 
Vote positif 0 Vote négatif
S

sive91

XLDnaute Junior
Bonjour,

Oui j'ai bien fait la modification, mais il me propose toujours d'enregistrer le classeur en xlsx, seuls les fichiers joints au mails sont bien en xls
L'enregistrement n'est pas trop chiant au final, par contre j'ai un bug au dela de 3 feuilles l'envoi ne se fait plus, comme si la macro plantait, et lorsque je regarde dans element envoyés je n'ai qu'un envoi celui de la premiere feuilles, si je dispose de 2 feuilles en plus de ma feuille entete, les deux s'envoient sans problème.

Aurais tu une petite idée?
 
Vote positif 0 Vote négatif

Discussions similaires

gothc
  • Question
XL 2021 choisir un onglet avant envoyer par email
Réponses
2
Affichages
333
gothc
gothc
J
  • Résolu(e)
XL 2013 Macro et script vba : macro s'arrête dès la première condition trouvée
Réponses
11
Affichages
421
Janu44
J
M
  • Résolu(e)
XL 2016 envoi de mail en automatique en fonction de plusieurs menus deroulants
2
Réponses
26
Affichages
1 K
mathieu20
M
B
  • Question
XL 2016 Envoyer PDF depuis Excel
Réponses
3
Affichages
904
benito87
B
M
  • Question
XL 2016 Macro copier coller une feuille sur email outloook
Réponses
1
Affichages
1 K
fanch55
fanch55
A
  • Question
Microsoft 365 Génération d'une feuille en Pdf et envoie par outlook
Réponses
5
Affichages
797
patricktoulon
patricktoulon
N
  • Question
Microsoft 365 donner a ma feuille le nom de l'onglet avant envoi par mails
Réponses
2
Affichages
780
Nabster
N
Skadi
  • Question
Autres MACRO POUR ENVOYER UN EMAIL
Réponses
0
Affichages
624
Skadi
Skadi
L
  • Résolu(e)
XL 2019 Lien Cliquable VBA Email
2
Réponses
20
Affichages
4 K
LuanaDDC
L
W
  • Résolu(e)
XL 2019 Macro pour envoyer un classeur en PDF par email
Réponses
3
Affichages
4 K
Pounet95
P

Membres actuellement en ligne

6 membres et 91 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 810
dernier inscrit
mohammedaminelahbali