Problème envoi mail avec Gmail

**jean30** · 05/10/2017, 15h12

Bonjour à tous,
J'ai un problème pour l'envoi de mail vis Gmail que je ne comprends pas.
Pouvez-vous m'aider svp.
Je ne suis pas très doué (du à mon âge) et je suis désolé si j'ai fais quelque chose que je n'aurai pas du faire.
En vous remerciant.
Voici le code :
Option Explicit
Option Compare Text

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub EnvoiMailCDO()
Dim mMessage As Object
Dim mConfig As Object
Dim mChps
 
    Set mConfig = CreateObject("CDO.Configuration")
 
    mConfig.Load -1
    Set mChps = mConfig.Fields
    Sheets("EnvoiMail").Select
    With mChps
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        'Adapter suivant votre serveur de mail. (exemple pour Gmail.) => Hotmail "smtp.live.com"
        'remplacez "smtp.nomserveur.fr" par le nom de serveur de votre FAI :
 
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = [E8].Value
 
        'En principe, 25 fonctionne avec tout les serveurs.
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = [E12].Value
 
        'Vous pouvez essayer sans ces trois lignes
        'Mais si votre serveur demande une authentification,
        If [E6].Value <> "" Then
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = [E6].Value
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = [E16].Value
        End If
        'Si votre serveur demande une connexion sûre (SSL)
        If [E14].Value <> "non" Then
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
        End If
        .Update
    End With
 
    Set mMessage = CreateObject("CDO.Message")
    With mMessage
    Set .Configuration = mConfig
        .To = [k6].Value
        .From = [E6].Value
        .Subject = [K8].Value
        .TextBody = [K10].Value
        'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
        '.AddAttachment 'Chemin et nom complet du fichier à joindre
'        .Send
    End With
    Set mMessage = Nothing
 
    'Libère les ressources
    Set mConfig = Nothing
    Set mChps = Nothing
End Sub

Invité · 05/10/2017, 15h29

Bonjour,

https://www.developpez.net/forums/d1...t/#post7968025

**jean30** · 05/10/2017, 15h34

Bonjour dysorthographie,
Je lis avec beaucoup d'attention le sujet que vous m'indiquez, mais ne comprenant pas l'anglais (dans les codes) je ne sais pas ce que je dois modifier.

Invité · 05/10/2017, 16h02

tu n'as pas à te soucier du code juste la méthode d'utilisation est utile (voir sub EnvoiMailCDO)!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Sub EnvoiMailCDO()
'MailEnvoi "smtp.googlemail.com", True, "My.Mail@gmail.com", "Pasw", 465, 10, "My.Mail@gmail.com", "Vous.Mail@gmail.com", "Copy@gmail.com", "Suivi des modifications.", "tel truc a été modifile", ""
 MailEnvoi [E8].Value, [E14].Value <> "non", [E6].Value, [E16].Value, [E12].Value, 10, [E6].Value, [k6].Value, "", [K8].Value, [K10].Value, "" ' pour les pièce jointes "c:\Fichier1;c:\Fichier2;"
'MailEnvoi(Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
End Sub
Public Sub MailEnvoi(Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
' sub pour envoyer les mails
Dim msg
Dim Conf
Dim Config
Dim ess
Dim splitPj
Dim IsplitPj
Set msg = CreateObject("CDO.Message") 'pour la configuration du message
Set Conf = CreateObject("CDO.Configuration") '  pour la configuration de l'envoi
Dim strHTML
 
Set Config = Conf.Fields
 
' Configuration des parametres d'envoi
'(SMTP - Identification - SSL - Password - Nom Utilisateur - Adresse messagerie)
With Config
If Identify = True Then
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = User
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PassWord
End If
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Port
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Serveur
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = Delay
    .Update
 
End With
 
 
'Configuration du message
'If E_mail.Sign.Value = Checked Then Convert ServeurFrm.SignTXT, ServeurFrm.Text1
 
With msg
    Set .Configuration = Conf
    .To = Dest
  .cc = DestEnCopy
    .FROM = Expediteur
    .Subject = Objet
'
 
    .HTMLBody = Body '"<p align=""center""><font face=""Verdana"" size=""1"" color=""#9224FF""><b><br><font face=""Comic Sans MS"" size=""5"" color=""#FF0000""></b><i>" & body & "</i></font> " 'E_mail.ZThtml.Text
            If Pj <> "" Then
        splitPj = Split(Pj & ";", ";")
 
        For IsplitPj = 0 To UBound(splitPj)
            If Trim("" & splitPj(IsplitPj)) <> "" Then
                .AddAttachment Trim("" & splitPj(IsplitPj))
            End If
        Next
 
    End If
    .Send 'envoi du message
 
End With
' reinitialisation des variables
Set msg = Nothing
Set Conf = Nothing
Set Config = Nothing
 
End Sub

**jean30** · 07/10/2017, 14h10

Bonjour dysorthographie,
Je ne m'en sors pas avec l'envoi de mail.
Accepteriez-vous de m'aider ?
En vous remerciant.

**jean30** · 08/10/2017, 17h15

Re,
Dans le fichier, et dans le module : Envoi_Mail_Sans_Outloock
La macro fonctionne, ma problématique est expliquée sur la feuille Base.
Mais je ne sais pas si c'est possible. Si Oui, je ne sais pas faire.
La grosse difficulté supplémentaire est que ce sera sur 4 postes tous différents qui possèdent :
1 - Excel Word Powerpoint
2 - Office 2007
3 - Office 2013
4 - Office 2016
Y aura-t-il un problème de compatibilité ?
En vous remerciant.
http://www.cjoint.com/c/GJipfs7CigO

Invité · 09/10/2017, 09h11

Bonjour,

en mode approuvé (SSL), l’émetteur ne peut être que le propriétaire du compte! propriétaire du compte= "janloudel@gmail.com" ;émetteur="janloudel@gmail.com"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Option Explicit
 
' Pour les personnes - ne disposant pas - de Outloock
 
 
    Public Sub EnvoiMailGoogle()
   MsgBox MailEnvoi("smtp.gmail.com", True, "janloudel@gmail.com", "jandel372", 465, 10, "janloudel@gmail.com", "janloudel@orange.fr", "", "Le sujet du mail", "Ce mail vous est envoyer pour tester la macros.", "")
    End Sub
 
Function MailEnvoi(Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
' sub pour envoyer les mails
Dim msg
Dim Conf
Dim Config
Dim ess
Dim splitPj
Dim IsplitPj
 MailEnvoi = "Le mail a été envoyer"
Set msg = CreateObject("CDO.Message") 'pour la configuration du message
Set Conf = CreateObject("CDO.Configuration") '  pour la configuration de l'envoi
Dim strHTML
 
Set Config = Conf.Fields
 
' Configuration des parametres d'envoi
'(SMTP - Identification - SSL - Password - Nom Utilisateur - Adresse messagerie)
With Config
If Identify = True Then
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = User
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PassWord
End If
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Port
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Serveur
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = Delay
    .Update
 
End With
 
 
'Configuration du message
'If E_mail.Sign.Value = Checked Then Convert ServeurFrm.SignTXT, ServeurFrm.Text1
 
With msg
    Set .Configuration = Conf
    .To = Dest
  .CC = DestEnCopy
    .From = Expediteur
    .Subject = Objet
'
 
    .HTMLBody = Replace(Body, vbCrLf, "<BR/>") '"<p align=""center""><font face=""Verdana"" size=""1"" color=""#9224FF""><b><br><font face=""Comic Sans MS"" size=""5"" color=""#FF0000""></b><i>" & body & "</i></font> " 'E_mail.ZThtml.Text
            If Pj <> "" Then
        splitPj = Split(Pj & ";", ";")
 
        For IsplitPj = 0 To UBound(splitPj)
            If Trim("" & splitPj(IsplitPj)) <> "" Then
                .AddAttachment Trim("" & splitPj(IsplitPj))
            End If
        Next
 
    End If
    On Error Resume Next
    .Send 'envoi du message
       If Err <> 0 Then MailEnvoi = Err.Description
 On Error GoTo 0
End With
' reinitialisation des variables
Set msg = Nothing
Set Conf = Nothing
Set Config = Nothing
 
End Function

**jean30** · 09/10/2017, 22h10

Re,
Je te remercie chaudement dysorthographie, c'est très sympa à toi et j'apprécie beaucoup.
Au plaisir de te rencontrer de nouveau.

**jean30** · 15/10/2017, 15h14

Re,
Lors d'essai, je reçois toujours une alerte du FAI comme quoi ma boîte mail a pu être piratée, peut-on l'éviter ?
En te remerciant.

Invité · 15/10/2017, 15h45

Bonjour,

Oui, par exemple j'ai configuré ma boîte mail en IMAP POUR Pouvoir lire mes mail de chez moi,sur mon téléphone, ma tablette ou du travail! Je reçois des mails de Google pour me dire qu'on a essayer de ce connecter! Bien que pour le coup Google ma routé vers la pages d'identification pour configurer le client mail, je reçois ces messages!