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