Enregistrer classeur actif et envoyer par gmail (CDO)

Le 24/05/2018 à 22:57

Bonjour à tous ,

j´ai un code avec lequel j´envoie un fichier d´un chemin spécifique que j´aimerais adapter pour savoir envoyer le classeur actif en pièce jointe et non un fichier quelconque venant d´un chemin spécifié ... Le code fonctionne avec Gmail , je l´ai vérifié .

Donc je bloque pour enregistrer le classeur en cours , car je ne sais comment m´y prendre , de plus je devrais modifier de telle sorte que la pièce jointe soit le classeur en cours .

Je voudrais aussi savoir comment mettre plusieures adresses mail pour .to , .cc et .bcc ...

123classeur-essai-envoi-gmail.xlsm (25.92 Ko)

Je vous mets en pièce jointe le fichier avec le code .

Merci d´avance pour votre aide .

Fschauer21

Le 25/05/2018 à 20:45

Bonjour,

à tester,

fichier = ThisWorkbook.FullName
.AddAttachment (fichier)

Le 25/05/2018 à 22:27

Bonjour sabV ,

Je dois faire un copier/coller de la partie que tu me donnes comme exemple et où dois-je le placer dans mon code vba ?

Déjà un grand merci de m´avoir répondu , pour ma part il me reste à tester quand je saurai où le placer ...

Fschauer21

Le 25/05/2018 à 23:24

Rebonjour sabV ,

Apparemment , la partie de code que tu m´as renseigné me donne une erreur : Le fichier est déjà en cours d´utilisation .

Est ce possible de faire une sauvegarde du fichier en cours , car une copie du fichier en cours va automatiquement générer une erreur ?

Merci pour le début de piste ,

Fschauer21

Le 26/05/2018 à 01:35

Bonjour,

la seule autre possibilité que je connaisse est d'installé le Add-In créer par Ron de Bruin

http://www.rondebruin.nl/win/addins/rdbmail.htm

Le 26/05/2018 à 07:32

Bonjour,

En cherchant dans mes archives j'ai retrouvé cette macro que j'ai testée sur xl2010.

À ma grande surprise elle fonctionne toujours,

53test-mail-xldialogsendmail.xlsm (17.24 Ko)

Sub test_mail_xlDialogSendMail()
'xlDialogSendMail: Recipients , Subject, return_receipt
'xlDialogMailEditMailer : to_recipients, cc_recipients, bcc_recipients , Subject, Enclosures, which_address
Dim sTo As String
Dim sObject As String
sTo = "xxxxxxxxxxxxx@yyy.com"
sObject = "test"
Application.Dialogs(xlDialogSendMail).Show sTo, sObject
End Sub

Le 26/05/2018 à 12:34

Bonjour sabV ,

Ta macro fonctionne bien avec Outlook , ...

Mais le problème avec Outlook , l'adresse que j'utilises est du boulot et hypersécurisée , du coup le fichier excel *.xlsm est directement bloqué par le serveur de la société à cause du macro....

Pour éviter ça , j'ai créé une adresse similaire chez gmail et le macro avec lequel j'ai débuté ici sur le forum était géniale , sauf que la pièce jointe ne sais pas être le classeur en cours ...

Je devrais enregistrer une copie du classeur actif sur un autre nom de fichier , de l'autre côté il suffit de le renommer si on veut conserver le même nom ...

Aurais tu une piste à me donner pour incorporer l'enregistrement d'une copie du classeur dans un dossier spécifique (ex: Temp) , alors je penses que si il n'y a pas d'erreur (fichier déjà utilisé par une application) cela devrait aller en lui donnant comme pièce jointe le chemin de ce nouveau fichier , puis vider le dossier Temp ...?

Merci déjà pour tes pistes , je suis un très petit débutant en ce qui concerne VBA ...

Si quelqu'un d'autre a des ideés , je suis aussi preneur ...

Bonne journée ,

Fschauer21

Le 26/05/2018 à 19:15

re..

est ce que le fichier que vous devez envoyer pourrait être sans code vba ?

si oui vous pourriez faire une copie de toutes les onglets du classeur dans un nouveau et envoyer ce nouveau classeur.

Le 26/05/2018 à 20:53

Hello sabV ,

malheureusement , le classeur doit être envoyé complètement ... Il se peut que je doive le corriger à domicile quand je ne suis pas au boulot ...

Pour le moment je sauvegarde le fichier sur une clé usb ... Mais cela devrait se faire automatiquement quand je clique sur le bouton , car je fais en ce moment 3 sauvegardes : une le matin en commencant , une à la pause de midi , et enfin avant de retourner ...

Dis moi , ce que Ron Debruin a fait comme "macro" ou "module" , cela consiste en quoi exactement ? il faut installer cela en plus d´excel?

Merci pour ton aide .

Bien à toi ,

Fschauer21

Le 27/05/2018 à 10:06

Bonjour sabV,

En rentrant du boulot hier , je me suis penché sur le problème , et en réfléchissant , j'ai peut être une bonne piste :

Pour pouvoir envoyer le bon fichier , je dois enregistrer le classeur en cours , j'ai un fichier qui fait ça je dois voir la macro,

puis faudra faire une copie du fichier , comme la copie est automatiquement prise en classeur actif , je devrais pouvoir l'envoyer ,

restera plus qu'à effacer la copie avec Kill (ça pourrait fonctionner ?!) ....

Pour faire la copie du classeur sur un autre nom , j'ai testé et c'est ok.

envoyer le fichier , ça j'avais la macro , faut adapter si nécessaire ,

et enfin pour effacer le fichier de copie , la fonction Kill (recherche sur le net) avec DoEvents pour laisser le temps au fichier de se libérer....

Voilà ce que j'ai trouvé:

Sub Test()

Kill cheminetnomdufichieràsupprimer

End Sub

Merci pour l'aide , si nécessaire je reviendrai vers toi sabV ,

J'espère bientôt pouvoir marquer le sujet résolu ....

Bonne journée,

Fschauer21

Le 28/05/2018 à 02:52

Bonjour,

dans votre fichier vous pourrier mettre la macro,

Sub Mail_ClasseurActif()
Application.Run "Personal.xlsb!Mail_ClasseurActif"
End Sub

et dans un module de votre classeur de macro perso

Const fichier = "fichierÀenvoyer.xlsm"  'adapter le nom "\fichierÀenvoyer"

Sub Mail_ClasseurActif()
Chemin = ActiveWorkbook.Path
cheminLeMaitre = ActiveWorkbook.FullName
ActiveWorkbook.SaveAs Chemin & "\" & fichier
Workbooks.Open cheminLeMaitre

EnvoieMailGoogle Chemin & "\" & fichier

Kill Chemin & "\" & fichier
End Sub

Public Sub EnvoieMailGoogle(file)
Dim mMessage As Object
Dim mConfig As Object
Dim mSch

    Set mConfig = CreateObject("CDO.Configuration")
    'mConfig.Load -1
    Set mSch = mConfig.Fields
    With mSch
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        'Adapter suivant votre serveur de mail. (exemple pour Gmail.)=> Hormail "smtp.live.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        'En principe, 25 fonctionne avec tout les serveurs.
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        'Si le serveur demande une authentification,
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "ehbo.psc@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Lx9ZtMZA"
        'Si votre serveur demande une connexion sûre (SSL)
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
        .Update
    End With
    Set mMessage = CreateObject("CDO.Message")
    With mMessage
    Set .Configuration = mConfig
        .To = "fschauer21@gmail.com"
        .From = "fschauer21@gmail.com"
        .Subject = "Copie du fichier gestion des stocks ehbo psc"
        .TextBody = "Ce mail vous est envoyé pour copie de sécurité." 'vbCrLf = retour a la ligne
        'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
        Windows(fichier).Close
        .AddAttachment (file)
        'Envoie du mail
        .send
    End With
    'Libère les ressources
    Set mMessage = Nothing
    Set mConfig = Nothing
    Set mSch = Nothing
    'Message de confirmation d'envoie
    MsgBox "Le mail a été envoyé"
End Sub

Le 28/05/2018 à 20:48

Bonjour sabV,

Faudra que je teste , mais en ce moment , je vais avoir une semaine assez chargée .

Depuis la dernière fois , j´étais en train de tester l´envoi de la copie du fichier , qui fonctionne à une condition qui est de se retrouver avec 3 fichiers , l´original , la copie pour envoi et le troisième pour l´envoi .... Plusieurs essais consécutifs en opérant des changements à l´original , le programme demande si on doit remplacer les 2 fichiers , je vais donner ce que j´avais fait (je suis débutant mais je suis fier d´essayer par moi-même , il faut parfois que d´autres me donne le bon départ , la piste qui aide ...) .

Pour le premier bouton qui enregistre :

Sub enregistrement()
    ActiveWorkbook.Save
    With ThisWorkbook
    .SaveAs .Path & "\" & "Classeur essai envoi gmail 2"
    .SaveAs .Path & "\" & "copie sauvegarde"
    End With
    End Sub

Et pour le bouton d´envoi :

Public Sub EnvoieMailGoogle()
    Dim mMessage As Object
    Dim mConfig As Object
    Dim mSch
    Set mConfig = CreateObject("CDO.Configuration")
    'mConfig.Load -1
    Set mSch = mConfig.Fields
    With mSch
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        'Adapter suivant votre serveur de mail. (exemple pour Gmail.)=> Hormail "smtp.live.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        'En principe, 25 fonctionne avec tout les serveurs.
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        'Si le serveur demande une authentification,
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "******@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "*******"
        'Si votre serveur demande une connexion sûre (SSL)
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
        .Update
    End With
    Set mMessage = CreateObject("CDO.Message")
    With mMessage
    Set .Configuration = mConfig
        .To = "**********@gmail.com"
        .From = "********@gmail.com"
        .Subject = "Copie du fichier gestion des stocks *********"
        .TextBody = "Ce mail vous est envoyé pour copie de sécurité." 'vbCrLf = retour a la ligne
        'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
        .AddAttachment ("C:\Users\PC\Downloads\essai excel\Classeur essai envoi gmail 2.xlsm")
        'Envoie du mail
        .Send
    End With
    'Libère les ressources
    Set mMessage = Nothing
    Set mConfig = Nothing
    Set mSch = Nothing
    'Message de confirmation d'envoie
    MsgBox "Le mail a été envoyé"
End Sub

Donc je laisse les 3 fichiers et je les remplace à chaque enregistrement , donc je n´ai plus besoin de la fonction kill ....

Mais faire les 2 fonctions par un seul bouton n´est pas possible ....

Merci pour ton aide sabV

Bonne soirée ,

fschauer21

Rechercher des sujets similaires à "enregistrer classeur actif envoyer gmail cdo"