VBA: Envoyer un email par Gmail avec feuilles en pièces jointes

GuillaumA

XLDnaute Occasionnel
EDIT : Fichier Disponible page 3 : Post #35


Cordialement,
Guillaume A.
 
Dernière édition:

GuillaumA

XLDnaute Occasionnel
Re : Envoyer feuille excel par mail (gmail)

Re-bonjour Excel-lent, le forum,
J'ai trouvé ça:


Dans Outils/Références cocher OutLook

Code:
Sub envoi_Feuille()
  répertoireAppli = ActiveWorkbook.Path
  Sheets("résultats").Copy
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs répertoireAppli & "\Resultats.xls"
  ActiveWindow.Close
  '--- Envoi par mail
  Dim olapp As [COLOR="Red"]Outlook.Application[/COLOR]
  Sheets("destinataires").Select
  Range("A11").Select
  Do While Not IsEmpty(ActiveCell)
     Dim msg As MailItem
     Set olapp = New [COLOR="red"]Outlook.Application[/COLOR]
     Set msg = olapp.CreateItem(olMailItem)
     msg.To = ActiveCell.Value
     msg.Subject = Range("A2").Value
     msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
     msg.Attachments.Add Source:=répertoireAppli & "\Resultats.xls"
     msg.Send
     ActiveCell.Offset(1, 0).Select
  Loop
End Sub
http://boisgontierjacques.free.fr/
Cela marche parfaitement avec Outlook.

J'imagine que ce qu'il faut modifier est ce que j'ai surligné en Rouge?

Comment pointer sur Gmail ?

A noter que nombreux sont les exemples avec Outlook sur le net, mais absolument introuvable pour Gmail. Mais la solution existe, j'en suis sûre, je l'ai déjà vu à l'oeuvre chez un collègue.

Toute aide ou indice est plus que bienvenue. Merci!
Ce serait bien d'avoir une solution sur cet excellent site.

Cordialement,
Guillaume A.
 
Dernière édition:

GuillaumA

XLDnaute Occasionnel
Re : Envoyer feuille excel par mail (gmail)

Et bien en continuant un peu mes recherches, il se trouve que la méthode énoncée précédemment est une méthode spécifique à Outlook est absolument inapproprié au cas de Gmail.


J'ai trouvé un super code modulable sur un autre forum. Adaptable à n'importe quel messagerie, entièrement automatique, il se base sur la simulation de l'appui sur les touches à utiliser pour envoyer le message.

Seulement voila, Gmail n'est pas du lot. Quelqu'un aurait'il dont les spécificités Gmail à nous faire partager ?

Exemple Spécificités raccourcis Outlook:
Code:
Sub OutLookExpress()
'Initialisation des tableaux de touches pour Outlook Express
    ' Pour une pièce jointe
    TouchesPJ(0) = 2        ' Nombre de touches nécessaires
    TouchesPJ(1) = "%i"     ' Appel du menu Insertion par la touche Alt-i
    TouchesPJ(2) = "p"      ' appel du sous-menu pièce par la touche p
    ' Pour l'envoi du mail
    TouchesEnvoi(0) = 1     ' Nombre de touches nécessaires
    TouchesEnvoi(1) = "%s"  ' Envoi du message avec Alt-s
 

GuillaumA

XLDnaute Occasionnel
Re : Envoyer feuille excel par mail (gmail)

Code:
Sub Gmail()
    ' Pour une pièce jointe [COLOR="red"]'toujours introuvable[/COLOR]
    TouchesPJ(0) =         ' Nombre de touches nécessaires
    TouchesPJ(1) = ""     ' Appel du menu Insertion par la touche 

    ' Pour l'envoi du mail
    TouchesEnvoi(0) = 1     ' Nombre de touches nécessaires
    TouchesEnvoi(1) = "[COLOR="Red"]jesaispascommentlecrire[/COLOR]"  ' Envoi du message avec [COLOR="red"]Maj-Enter[/COLOR]

Aidez moi et je donnerai le code final promis :(
 

JNP

XLDnaute Barbatruc
Re : Envoyer feuille excel par mail (gmail)

Bonjour le fil :),
Seulement voila, Gmail n'est pas du lot. Quelqu'un aurait'il dont les spécificités Gmail à nous faire partager ?
Quand tu parles d'utiliser GMail, tu veux dire passer par IE pour te connecter sur ton compte GMail et envoyer le mail ? Si c'est le cas, il va falloir créer par VBA une instance d'IE et faire de la simulation de touche, ce qui ne sera pas évident et en plus, la moindre modification de l'interface de GMail t'obligera à reprendre ta macro :eek:.
Si par contre, tu veux simplement utiliser ton adresse GMail pour envoyer des mails, tu peux passer par CDO. Tu peux regarder ce fil, j'ai l'impression que le code est très complet ;).
Si tu as besoin de garder une copie du mail envoyé, le plus simple est de te mettre dans les destinataires :D.
Bon courage :cool:
 

GuillaumA

XLDnaute Occasionnel
Re : Envoyer feuille excel par mail (gmail)

Attention passage en mod pro.

Voila mon nouveau code. Expliqué.


Code:
Sub envoigmail()


Const cdoSendUsingPickup = 1 [COLOR="green"]'Send message using the local SMTP service pickup directory.[/COLOR]
Const cdoSendUsingPort = 2 [COLOR="green"]'Send the message using the network (SMTP over the network).[/COLOR]

Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM


Dim statut As Boolean
Dim destinataires As String
Dim sujet As String
Dim corps As String


reponse = MsgBox("Le mail sera directement envoyé. Etes-vous sûr de vouloir continuer ?", vbOKCancel + vbExclamation, "Avertissement")
If reponse = vbOK Then
Else
Exit Sub
End If

destinataires = Range("Feuil2!b11").Value
expediteur = Range("Feuil2!b23").Value
adresseexpediteur = Range("Feuil2!B26").Value
sujet = Range("Feuil2!b2").Value
corps = Range("Feuil2!b5").Value

On Error GoTo SMTPSendMail_Err

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = sujet
objMessage.From = expediteur
objMessage.To = destinataires
objMessage.TextBody = corps
    If Not IsMissing(pj) Then
    objMessage.AddAttachment pj
    End If

[COLOR="green"]'==This section provides the configuration information for the remote SMTP server.[/COLOR]

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

[COLOR="green"]'Name or IP of Remote SMTP Server[/COLOR]
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

[COLOR="green"]' Type of authentication, NONE, Basic (Base64 encoded), NTLM[/COLOR]
 objMessage.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"

[COLOR="green"]'Your UserID on the SMTP server[/COLOR]
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = InputBox("Veuillez saisir votre identifiant (imap)")
[COLOR="green"]'Your password on the SMTP server[/COLOR]
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = InputBox("Veuillez saisir votre mot de passe gmail (imap)")

[COLOR="green"]'Server port (typically 25)[/COLOR]
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = [COLOR="Purple"]HIDDEN[/COLOR]

[COLOR="green"]'Use SSL for the connection (False or True)[/COLOR]
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

[COLOR="green"]'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)[/COLOR]
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

objMessage.Configuration.Fields.Update

[COLOR="Green"]'==End remote SMTP server configuration section==[/COLOR]

objMessage.Send


'Next i


succes = MsgBox(nbmessages & " envoyés avec succès !", vbInformation)
Exit Sub
SMTPSendMail_Err:
    'Gestion des erreurs
    tmp = MsgBox("Erreur lors de l'envoi de votre message." & Chr(10) & "Détails : " & Err.Description, vbCritical)


End Sub


Problème, à la fin message d'erreur suivant
Erreur lors de l'envoi de votre message.
Détails: Le message n'a pu être envoyé vers le serveur SMTP. Le code d'erreur de transport était 0x80040217. La réponse du serveur était not available.

En gros, je ne joint toujours pas le serveur.
Si quelqu'un à déjà eu ce problème, je lui serait reconnaissant de me faire partager ses résultats!

Cordialement,
Guillaume
 

GuillaumA

XLDnaute Occasionnel
Re : Envoyer feuille excel par mail (gmail)

Après simplification pour meilleur lisibilité.

Code:
Dim statut As Boolean
Dim destinataires As String
Dim sujet As String
Dim corps As String
Dim pj As String
Dim expediteur As String

reponse = MsgBox("Le mail sera directement envoyé. Etes-vous sûr de vouloir continuer ?", vbOKCancel + vbExclamation, "Avertissement")
If reponse = vbOK Then
Else
Exit Sub
End If

destinataires = "exempleD@gmail.com"
expediteur = "Dupont"
adresseexpediteur = "exempleE@gmail.com"
sujet = "hello world"
corps = "hello guil how re ya"

On Error GoTo SMTPSendMail_Err

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = sujet
objMessage.From = expediteur
objMessage.To = destinataires
objMessage.TextBody = corps

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

 objMessage.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = InputBox("Veuillez saisir votre identifiant")

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = InputBox("Veuillez saisir votre mot de passe gmail")

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

objMessage.Configuration.Fields.Update

objMessage.Send

succes = MsgBox(" envoyés avec succès !", vbInformation)

Exit Sub

SMTPSendMail_Err:
    'Gestion des erreurs
    tmp = MsgBox("Erreur lors de l'envoi de votre message." & Chr(10) & "Détails : " & Err.Description, vbCritical)


End Sub

Pourquoi le serveur refuse ma connection ?
J'ai même mis les deux Microsoft CDO (for windows 2000 + 1.21) Librazy dans Objets ==> Références de l'interface VBA et il y a toujours le bug !

Mes chers experts Excel, quelqu'un à déjà eu le même soucis ?
 
Dernière édition:

Cousinhub

XLDnaute Barbatruc
Re : [EXPERT]Envoyer feuille excel par mail (gmail)

Bonsoir,

Je vois que tu dépasses les 200 messages....

Mais, que tu n'as pas du comprendre la charte....

Dans chaque post, tu ne demandes que l'avis des "pros", "Experts"

Aidez moi et je donnerai le code final promis
Attention passage en mod pro.
Mes chers experts Excel

Tes réflexions ne me donnent vraiment pas envie de t'aider, sous peur de te "décevoir"....

quelqu'un aurait'il l'amabilité de me donner un lien pertinent ?

C'est un fait, qu'ici, il nous arrive de donner des liens Lien supprimé....

Bonne soirée
 

GuillaumA

XLDnaute Occasionnel
Re : Envoyer feuille excel par mail (gmail)

Ecoute, lorsque je pose des questions, il m'arrive dans poser assez poussée.
Ici il s'agit d'un problème plus lié aux réseaux smtp qu'au vba. Et je sais me remettre en question lorsque je suis dans l'incapacité d'avancer.
Après je ne cherchai aucunement à t'offenser et il n'y a pas de raisons à le prendre mal.

En terme de charte, je pense la comprendre et n'ai pas besoin que l'on me la rappelle. Après tu ne peux me juger négativement sur un post car j'ai mis le mot expert dedans. Check mes autres posts et tu verras bien.

PS: Par ailleurs le mot [expert] n'a été rajouté qu'à partir du post #9. Tu verras qu'entre le début et la fin, il y a une différence.
PS2: J'ai enlevé la dénomination [Expert] qui ne te plaisais pas.
PS3: Allez une dernière fois: Expert

Amicalement,
Bonne soirée
 
Dernière édition:

GuillaumA

XLDnaute Occasionnel
Re : Envoyer feuille excel par mail (gmail)

Re-bonjour.
Comme promis, voici un code fonctionnant parfaitement

Nécessite dans Microsoft VBA d'activer Microsoft CDO for Windows 2000 Library (Outils ==> Références)

Public Sub SendMailCDO()


Dim D As String
Dim E As String
Dim S As String
Dim T As String
Dim pj As String

D = Range("B31").Value
E = Range("B26").Value
S = Range("B2").Value
T = Range("B5").Value & Chr(10) & Chr(10) & Range("B8").Value
' pj = Range("B20").Value


Dim Cdo_Message As New CDO.Message
Set Cdo_Message.Configuration = GetSMTPServerConfig()
With Cdo_Message
.To = D
.From = E
.Subject = S
.TextBody = T
' If Not IsMissing(pj) Then
' .AddAttachment pj
' End If
.send
End With

success = MsgBox(nbmessages & " envoyés avec succès !", vbInformation)

Exit Sub
SMTPSendMail_Err:
'Gestion des erreurs
tmp = MsgBox("Erreur lors de l'envoi de votre message." & Chr(10) & "Détails : " & Err.Description, vbCritical)

End Sub

Avec en B31 (D comme destinataires):
Code:
=GAUCHE(SI(B11="";"";B11&";")&SI(B12="";"";B12&";")&SI(B13="";"";B13&";")&SI(B14="";"";B14&";")&SI(B15="";"";B15&";")&SI(B16="";"";B16&";")&SI(B17="";"";B17&";");NBCAR(SI(B11="";"";B11&";")&SI(B12="";"";B12&";")&SI(B13="";"";B13&";")&SI(B14="";"";B14&";")&SI(B15="";"";B15&";")&SI(B16="";"";B16&";")&SI(B17="";"";B17&";"))-1)

Deuxième partie du code. A mettre au même endroit que SendMailCDO()
Function GetSMTPServerConfig() As Object

Dim Cdo_Config As New CDO.Configuration
Dim Cdo_Fields As Object

Set Cdo_Fields = Cdo_Config.Fields
With Cdo_Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = "smtp.gmail.com"
.Item(cdoSMTPServerPort) = 465
.Item(cdoSendUserName) = InputBox("Veuillez saisir votre identifiant")
.Item(cdoSendPassword) = InputBox("Veuillez saisir votre mot de passe gmail")
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSMTPUseSSL) = True
.Update
End With

Set GetSMTPServerConfig = Cdo_Config
Set Cdo_Config = Nothing
Set Cdo_Fields = Nothing
End Function

Je vous joint le fichier qui va avec.


Cette macro marche pour des pièces jointes qui ne sont que des classeurs complets.
Si quelqu'un sait comment modifier ce que j'ai fait pour envoyer juste une feuille (onglet) du classeur actif (celui ou il y aura ce formulaire) je suis preneur.

A noter que la cellule des fichiers joints (B20 dans l'exemple) doit contenir l'adresse complète de destination vers la feuille
ex:C:\Documents and Settings\user\Mes documents\test.xls
On peut ici aussi utiliser l'astuce précédemment vu pour envoyer à de multiples destinataires.


Cordialement,
Guillaume
 

Pièces jointes

  • EnvoiMAILautomatiquementParGmail.xls
    44 KB · Affichages: 838
Dernière édition:

GuillaumA

XLDnaute Occasionnel
Re : Envoyer feuille excel par mail (gmail)

Très prochainement capable de partager avec vous une méthode afin d'envoyer en pièce jointe les feuilles sélectionnées, j'aurai besoin de savoir quelle est la méthode afin de supprimer un classeur.
J'utilise:
Code:
Workbooks("C:\Documents and Settings\user\Mes documents\" & NomDeLaFeuille & ".xls")[COLOR="Red"].Erase[/COLOR]
(NomDeLaFeuille est une variable défini)

Ce que je souhaite, c'est sélectionner un classeur dans mon répertoire "Mes documents" et le supprimer. J'ai testé .Erase .Delete, ça n'existe pas. Ou alors je l'utilise mal. Peut être faut t'il ouvrir le classeur d'abord?

Merci de votre considération.

Guillaume
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 203
Messages
2 086 181
Membres
103 152
dernier inscrit
Karibu