Envoi mail sur gmail

Bonsoir à tous

J'ai avancé sur la macro de mon deuxième sujet posté ici (à savoir alertes sur dates butoirs). Elle fonctionne bien avec des MsgBox mais je veux les remplacer par des alertes envoyées automatiquement sur gmail et là cela devient compliqué.

Je rappelle le but est de déclarer 15 jours avant une date butoir que l’événement va arriver à échéances (colonne B) mais que également si une cellule de la colonne B est vide pas d'alerte et également si une autre case est validée pas d'alerte. Tout cela marche si je reste en MsgBox. J'ai voulu coder pour envoi de mail et là c'est plus compliqué. J'ai une erreur de transport comme quoi le transfert a échoué :"Erreur d'exécution....(80024013). Le transport a échoué dans sa connexion au serveur.

Voici le code :

Sub Workbook_Open()
nbalert = 0
derlig = Sheets("Tableau suivi clients").Cells(Cells.Rows.Count, "A").End(xlUp).Row
For Each c In Sheets("Tableau suivi clients").Range("P2:p" & derlig)
ecart = c - Date
c.Interior.ColorIndex = -4142
If ecart <= 15 And c.Offset(0, 2) < 2 And c <> "" Then
Call envoi(c.Offset(0, -15) & " est définie dans " & ecart & " jours")

nbalert = nbalert + 1
c.Interior.Color = RGB(255, 0, 0)
End If
Next
End Sub

Sub envoi(mess)
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
With iConf.fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxxxxxx@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxx"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465

.Update
End With
With iMsg
Set .Configuration = iConf
.To = "xxxxxxxxxxx@gmail.com"
.CC = ""
.BCC = ""
.From = "xxxxxxxx@gmail.com"
.Subject = "Alert"
.textbody = mess
.Send

End With
End Sub

J'espère que j'aurai un peu plus de chance avec ce nouveau sujet que sur le 2ème

Merci par avance

Armorik75

Bonjour,

Ceci fonctionne ...

Par contre, il faut que Accès moins sécurisées des applications soit activé dans la sécurité de ton compte Gmail ... (ce que déconseille Gmail).

Sub Workbook_Open()
    nbalert = 0
    derlig = Sheets("Tableau suivi clients").Cells(Cells.Rows.Count, "A").End(xlUp).Row
    For Each c In Sheets("Tableau suivi clients").Range("P2:p" & derlig)
        ecart = c - Date
        c.Interior.ColorIndex = -4142
        If ecart <= 15 And c.Offset(0, 2) < 2 And c <> "" Then
'''            Call envoi(c.Offset(0, -15) & " est définie dans " & ecart & " jours")
            Call EnvoiMail(c.Offset(0, -15) & " est définie dans " & ecart & " jours")

            nbalert = nbalert + 1
            c.Interior.Color = RGB(255, 0, 0)
        End If
    Next
End Sub

 Sub EnvoiMail(mess)
    'Ajout référence  Microsoft CDO WINDOWS FOR 2000
    Dim cdo_msg As New CDO.Message

    'configuration message
    cdo_msg.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
    cdo_msg.Configuration.Fields(cdoSMTPConnectionTimeout) = 60
    cdo_msg.Configuration.Fields(cdoSendUsingMethod) = cdoSendUsingPort
    cdo_msg.Configuration.Fields(cdoSMTPServerPort) = 465
    cdo_msg.Configuration.Fields(cdoSMTPAuthenticate) = cdoBasic
    cdo_msg.Configuration.Fields(cdoSMTPUseSSL) = True
    cdo_msg.Configuration.Fields(cdoSendUserName) = "xxxxxxxxxxxxx@gmail.com"
    cdo_msg.Configuration.Fields(cdoSendPassword) = "LeMotDePasseDuCompteCiHaut"
    cdo_msg.Configuration.Fields.Update

    'remplissage et envoi message
    cdo_msg.To = "adresse1@gmail.com"
    cdo_msg.From = "adresse2@gmail.com"
    cdo_msg.Subject = "filename Sent to www.???.  com "
    cdo_msg.TextBody = mess
'    cdo_msg.AddAttachment ("C:\Users\nnnnnn\Documents\classeur1.xls")
    cdo_msg.Send

    'libération objet message
    Set cdo_msg = Nothing
End Sub

Il y a peut-être d'autres façons de faire que je ne connais pas.

ric

Bonjour,

Si ta macro est dans Sub Workbook_Open() ... à chaque fois que tu vas ouvrir ton fichier, les mails vont partir.

Ce ne sera pas sympa pour les clients.

ric

Bonsoir Ric

Je viens d'entendre le bip de réponse...et je tiens déjà à vous remercier pour cela. Je vais tester votre code.

En fait l'envoi des mails n'est pas pour le client mais pour moi sur ma boite mail et (également pour mes associés qui auront leurs propres tableaux et donc leurs propres alertes). Donc le fait de recevoir un mail tous les jours est justement le but si l'objectif est proche et pas atteint.

Je teste cela demain matin et je fais un retour sur le site.

Merci encore pour votre aide c'est très appréciable.

Cordialement

Armorik75

Bon je n'ai pas pu attendre malgré l'heure tardive et malheureusement ...ça ne fonctionne pas j'ai toujours un message d'erreur (je précise que outil/référence Microsoft CDO for windows 2000 library est bien coché et que j'ai baissé le niveau de sécurité de ma boite gmail). L'erreur est la suivante :

Le message n'a pas pu être envoyé vers le serveur smtp. Le code d'erreur de transport était 0x80040217. La réponse du serveur était not available

Précision je suis sur office 365 (je ne sais pas si cela peut avoir une incidence)

Si vous avez une idée merci par avance car je patauge depuis 3 jours avec cela

Armorik75

Bonjour à tous

Je précise que je viens même d'essayer en désactivant le firewall de mon ordinateur ça ne fonctionne pas.

Je ne comprends pas j'ai pourtant épluché les posts de Thev et de Steelson qui ont plusieurs fois traité du sujet. Mais quoique je fasse ça bloque

Bonjour,

Si Accès moins sécurisées des applications est bien activé dans le compte Gmail servant à l'envoi des mails.

S'il n'y a pas de faute dans l'adresse d'envoi :

cdo_msg.Configuration.Fields(cdoSendUserName) = "xxxxxxxxxxxxx@gmail.com".

S'il n'y a pas d'erreur dans le mot de passe de cette adresse d'envoi :

cdo_msg.Configuration.Fields(cdoSendPassword) = "LeMotDePasseDuCompteCiHaut".

Ce n'est donc pas le code qui est fautif.

https://codes-sources.commentcamarche.net/forum/affich-261261-webmail-erreur-acces-cdo-message-0x80040217#3

Étant donné que ces envois sont pour l'interne, est-ce essentiel que les courriels partent via Gmail ?

ric

que les mails partent de gmail non mais qu'ils arrivent sur une boite gmail oui

Tu penses à quoi ?

ca y est ca marche j'ai changé mes identifiants de connexion au serveur en prenant ceux de mon FAI orange et cela marche....

Code :

Sub Workbook_Open()
nbalert = 0
derlig = Sheets("Tableau suivi clients").Cells(Cells.Rows.Count, "A").End(xlUp).Row
For Each c In Sheets("Tableau suivi clients").Range("P2:p" & derlig)
ecart = c - Date
c.Interior.ColorIndex = -4142
If ecart <= 15 And c.Offset(0, 2) < 2 And c <> "" Then
Call envoi(c.Offset(0, -15) & " est définie dans " & ecart & " jours")

nbalert = nbalert + 1
c.Interior.Color = RGB(255, 0, 0)
End If
Next
End Sub

Sub envoi(mess)
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
With iConf.fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxxxx@orange.fr"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxx"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
.Update
End With
With iMsg
Set .Configuration = iConf
.To = "xxxxxxxxxxxx@gmail.com"
.CC = ""
.BCC = ""
.From = "xxxxxxxxxxx@gmail.com"
.Subject = "Alerte"
.TextBody = mess
.Send

End With
End Sub

Par contre c'est le workbook open qui ne marche plus maintenant quand j'ouvre mon fichier xls il se passe rien je suis obligé d'aller dans le développeur et d'appuyer sur exécuter la macro...UN PAS DEVANT DEUX PAS EN ARRIERE !!!

Bonjour,

Bravo pour le dépannage d'envoi ...

C'était donc le FAI qui posait problème.

Pour Sub Workbook_Open() est-ce que cette macro est bien dans ThisWorkbook ?

ric

Je suis vraiment idiot le code était placé dans le module 1 et pas dans Thisworkbook. Merci pour le coup de main Ric.

ric

Mais au fait Ric tu pensais à quoi quand tu m'as posé la question si c'était important que le mail parte de gmail ?

Bonjour,

Une personne, quelle que soit son adresse de courriel, peut écrire à n'importe quelle adresse de courriel.

Si l'envoi est problématique via un type d'adresse de courriel (Gmail, Hotmail, Outlook, Orange, Bell, etc.), l'on peut tenter d'envoyer via un autre type. C'est d'autant plus facile à l'aide d'un type d'adresse Web (Hotmail, Outlook, Yahoo, etc.), car ça ne prend que cinq minutes pour se créer une adresse Web.

Gmail est un fournisseur d'adresses de courriel qui restreint ou qui est restreint par les FAI pour l'envoi de courriel via des applications moins sécurisé.

J'ai galéré un bout quand j'ai paramétré SmartSync afin qu'il envoie des rapports de sauvegardes automatiques.

Si le succès n'avait pas été au rendez-vous, l'on aurait pu tenter d'utiliser un autre type d'adresse.

Mais quand tu as mentionné qu'Orange était ton FAI, je crois que, quel que soit le type d'adresse, la restriction aurait été la même et la solution également.

Je ne connais Orange que via la lecture sur différents forums. Il fait partie de certains FAI qui sont plus restrictifs. J'aurai dû y penser plutôt.

ric

Merci Ric pour ton éclaircissement car il va certainement mettre très utile car je dois déployer le même code pour mes associés mais qui ont tous des caractéristiques différentes (j'en ai même un qui a un Mac...merci du cadeau je sens que ca va être encore du sport, FAI différents, heureusement on travaille tous avec gmail pour la boite mail me voila sauvé).

Bonjour à tous

Je reviens vers vous car je voudrais améliorer ma macro mais j'ai un petit peu de mal.

Sub Workbook_Open()

nbalert = 0

derlig = Sheets("Tableau suivi clients").Cells(Cells.Rows.Count, "A").End(xlUp).Row

For Each c In Sheets("Tableau suivi clients").Range("P2:p" & derlig)

ecart = c - Date

c.Interior.ColorIndex = -4142

If ecart <= 15 And c.Offset(0, 20) < 2 And c <> "" Then

Call envoi(c.Offset(0, -15) & " arrive à échéance dans " & ecart & " jours")

nbalert = nbalert + 1

c.Interior.Color = RGB(255, 0, 0)

End If

Next

End Sub

Sub envoi(mess)
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
With iConf.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxxxxxx@orange.fr"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxxxxxx"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
.Update
End With

With iMsg
Set .Configuration = iConf

.To = "xxxxxxxxxxx@gmail.com"
.CC = ""
.BCC = ""
.From = "xxxxxxxxxxxxxx@gmail.com"
.Subject = "ALERTE CLAUSES SUSPENSIVES DOSSIER"
.TextBody = mess
.Send
End With
End Sub

Dans un premier temps je voudrais rajouter le nom du dossier correspondant à l'alerte dans l'objet du mail à la ligne Subject mais je n'y arrive pas.

Dans un 2ème temps je voudrais insérer un code afin de mettre une restriction à savoir quand un mail a été envoyé pour un dossier la macro n'en renvoi plus un pour le dossier concerné. Je pense que la macro doit écrire une information dans une colonne (par exemple colonne AS de mon tableau).

Vous en pensez quoi ? Merci pour votre aide.

Bonjour,

Un essai non testé ...

La première ligne (Dim C.....) doit être placée au dessus de toutes les macros du module.

Dim C As Range      ' variable placée au haut, le contenu sera accessible des deux macros (essentiel pour passer le no dossier)

Sub Workbook_Open()
    nbalert = 0
    derlig = Sheets("Tableau suivi clients").Cells(Cells.Rows.Count, "A").End(xlUp).Row

    For Each C In Sheets("Tableau suivi clients").Range("P2:p" & derlig)
        If C.Offset(0, 29).Value <> "OK" Then  ' colonne AS (29 colonnes plus loin que P
            ecart = C - Date
            C.Interior.ColorIndex = -4142

            If ecart <= 15 And C.Offset(0, 20) < 2 And C <> "" Then
                Call envoi(C.Offset(0, -15) & " arrive à échéance dans " & ecart & " jours")
                nbalert = nbalert + 1
                C.Interior.Color = RGB(255, 0, 0)
                C.Offset(0, 29).Value = "OK"    ' envoi complété, on l'indique en colonne AS
            End If
        End If
    Next
End Sub

Sub envoi(mess)
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
With iConf.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxxxxxx@orange.fr"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxxxxxx"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
.Update
End With

With iMsg
    Set .Configuration = iConf
    .To = "xxxxxxxxxxx@gmail.com"
    .CC = ""
    .BCC = ""
    .From = "xxxxxxxxxxxxxx@gmail.com"
                                                   ' la feuille, la colonne et la ligne est donnée par C.row
                                                   ' le C provient de la boucle dans l'autre macro
    .Subject = "ALERTE CLAUSES SUSPENSIVES DOSSIER " & Sheets("Tableau suivi clients").Range("P" & C.Row).Value
    .TextBody = mess
    .Send
End With
End Sub

ric

Juste deux mots...chapeau l'artiste. Cela fait deux jours que je me bats avec juste le premier point à savoir indiquer le nom du dossier sur le sujet du mail. Quand je pense que j'ai tout testé sauf le C.Row je me rends compte du chemin que j'ai encore à faire sur le VBA

Et pour le 2ème point alors là je n'ai pas de mot...je n'aurai jamais pensé à une telle hiérarchisation des codes car au final j'ai bien l'impression que c'est le cheminement qui compte et pas forcément les "ordres" même si bien sur c'est important.

Merci pour la leçon et surtout pour ton aide Ric.