Problème d'envoi d'un mail sur un serveur avec CDO et Gmail

Z

zephir94

XLDnaute Impliqué
Bonjour à tous,

J'ai écrit un petit code VBA pour envoyer un mail sans Outlook en passant par gmail.
Sur mon pc il marche parfaitement, en revanche sa coince sur .send sur le réseau ou je dois installer le fichier.
J'ai un message d'erreur " le transport à échoué dans sa connexion au serveur "
erreur d'exécution -2147220973(80040213)
voici mon code :

Code: 
Sub Mail_marché()
    Dim cel As Range
    Dim mMessage As Object
    Dim mConfig As Object
    Dim mChps
    Dim FilePath$
    Dim Formulaire$
    Dim nWb As Workbook
    Dim WshShell, utilisateur
    For Each cel In Sheets("mail").Range("B5:Z5")
    If cel.Value = "X" Then

     a = Sheets("mail").cells(cel.Row - 4, cel.Column)
     b = Sheets("mail").cells(cel.Row - 3, cel.Column)
     c = Sheets("mail").cells(cel.Row - 2, cel.Column)
     d = Sheets("mail").cells(cel.Row - 1, cel.Column)
    

    
    Set mConfig = CreateObject("CDO.Configuration")
    mConfig.Load -1
    Set mChps = mConfig.Fields
    With mChps
        .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
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "dede@gmail.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "dede"
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
        .Update
    End With
    Application.ScreenUpdating = False

    Set mMessage = CreateObject("CDO.Message")
    With mMessage
    Set .Configuration = mConfig
        .To = b & ";" & c & ";" & d & ";"
        .BCC = ""
        .FROM = "adresse@domaine.fr"
        .Subject = "Alerte " & a
        .TextBody = "Bonjour," & vbCrLf _
                & vbCrLf _
           & "Le stock" & " " & a & "" & " est" & " " & (Date + 1) & " & vbCrLf" _
          & vbCrLf _
          & "Cordialement" & vbCrLf _
          & vbCrLf & vbCrLf _
          & "Service Med , merci de ne pas répondre à ce mail il est généré automatiquement."
        
       .Send 
   
    End With
        'nWb.Close False 
    
    Set mMessage = Nothing
  
    'Libère les ressources
    Set mConfig = Nothing
    Set mChps = Nothing

End If
Next

End Sub

J'ai fait beaucoup de recherche et pas trouvé grande réponses !
Merci par avance pour vos aides
 
Dernière édition:
Trier par date Trier par votes
C

Compte Supprimé 979

Guest
Re : Problème d'envoi d'un mail sur un serveur avec CDO et Gmail

Bonjour Zephir94

zephir94 à dit:
J'ai écrit un petit code VBA pour envoyer un mail sans Outlook en passant par gmail.
Sur mon pc il marche parfaitement, en revanche sa coince sur .send sur le réseau ou je dois installer le fichier.
J'ai un message d'erreur " le transport à échoué dans sa connexion au serveur "
erreur d'exécution -2147220973(80040213)
Cliquez pour agrandir...
Normal, en réseau d'entreprise tu dois passer par un Proxy et ce genre de code bloque

zephir94 à dit:
J'ai fait beaucoup de recherche et pas trouvé grande réponses !
Cliquez pour agrandir...
Xptdr, j'en ai mal au ventre... beaucoup de recherche :rolleyes:
https://www.google.fr/webhp?q=vba+excel+utiliser+CDO+via+proxy

Essaye avec ceci
Code: 
Dim NewMail As Object Set NewMail = CreateObject("CDO.Message") 
With NewMail 
   .Subject = "my subject here"
   .From = "user@gmail.com"
   .To = "receiver@gmail.com"
   .CC = "" 
   .BCC = "" 
   .TextBody = "my text body here"
   .AddAttachment "myattach.pdf"
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/urlproxyserver") = "proxy.server:8080"
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/urlproxybypass") = "<local>"
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True 
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "user@gmail.com" 
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password" 
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" 
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 
   .Update 
End With 
NewMail.Send

A+
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Z

zephir94

XLDnaute Impliqué
Re : Problème d'envoi d'un mail sur un serveur avec CDO et Gmail

Merci beaucoup je viens de tester mais il bloque sur :

.update avec une erreur 438 et
send avec comme erreur la valeur de sendusing est non valide !

J'ai transformé mon code comme ceci :

Code: 
Sub test()


Dim NewMail As Object
    For Each cel In Sheets("mail").Range("B5:Z5")
    If cel.Value = "X" Then

     a = Sheets("mail").cells(cel.Row - 4, cel.Column)
     b = Sheets("mail").cells(cel.Row - 3, cel.Column)
     c = Sheets("mail").cells(cel.Row - 2, cel.Column)
     d = Sheets("mail").cells(cel.Row - 1, cel.Column)
Set NewMail = CreateObject("CDO.Message")
With NewMail
     .To = b & ";" & c & ";" & d & ";"
        .BCC = ""
        .From = "adresse@domaine.fr"
        .Subject = "Alerte" & a
        .TextBody = "Bonjour," & vbCrLf _
                & vbCrLf _
           & "" & " " & a & "" & "" & " " & (Date + 1) & " & vbCrLf" _
          & vbCrLf _
          & "Cordialement" & vbCrLf _
          & vbCrLf & vbCrLf _
          & " merci de ne pas répondre à ce mail il est généré automatiquement."
  
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/urlproxyserver") = "proxy.server:8080"
    .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/urlproxybypass") = "<local>"
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "dede@gmail.com"
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "dede"
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
   .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
   .Update
End With
NewMail.Send
End If
Next
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
JP.B

JP.B

XLDnaute Nouveau
zephir94 à dit:
Bonjour à tous,

J'ai écrit un petit code VBA pour envoyer un mail sans Outlook en passant par gmail.
Sur mon pc il marche parfaitement, en revanche sa coince sur .send sur le réseau ou je dois installer le fichier.
J'ai un message d'erreur " le transport à échoué dans sa connexion au serveur "
erreur d'exécution -2147220973(80040213)
voici mon code :

Code: 
Sub Mail_marché()
    Dim cel As Range
    Dim mMessage As Object
    Dim mConfig As Object
    Dim mChps
    Dim FilePath$
    Dim Formulaire$
    Dim nWb As Workbook
    Dim WshShell, utilisateur
    For Each cel In Sheets("mail").Range("B5:Z5")
    If cel.Value = "X" Then

     a = Sheets("mail").cells(cel.Row - 4, cel.Column)
     b = Sheets("mail").cells(cel.Row - 3, cel.Column)
     c = Sheets("mail").cells(cel.Row - 2, cel.Column)
     d = Sheets("mail").cells(cel.Row - 1, cel.Column)
   

   
    Set mConfig = CreateObject("CDO.Configuration")
    mConfig.Load -1
    Set mChps = mConfig.Fields
    With mChps
        .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
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "dede@gmail.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "dede"
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
        .Update
    End With
    Application.ScreenUpdating = False

    Set mMessage = CreateObject("CDO.Message")
    With mMessage
    Set .Configuration = mConfig
        .To = b & ";" & c & ";" & d & ";"
        .BCC = ""
        .FROM = "adresse@domaine.fr"
        .Subject = "Alerte " & a
        .TextBody = "Bonjour," & vbCrLf _
                & vbCrLf _
           & "Le stock" & " " & a & "" & " est" & " " & (Date + 1) & " & vbCrLf" _
          & vbCrLf _
          & "Cordialement" & vbCrLf _
          & vbCrLf & vbCrLf _
          & "Service Med , merci de ne pas répondre à ce mail il est généré automatiquement."
       
       .Send
  
    End With
        'nWb.Close False
   
    Set mMessage = Nothing
 
    'Libère les ressources
    Set mConfig = Nothing
    Set mChps = Nothing

End If
Next

End Sub

J'ai fait beaucoup de recherche et pas trouvé grande réponses !
Merci par avance pour vos aides
Cliquez pour agrandir...
Bonjour Zéphir
J'ai un pb identique et je suis curieux de voir les éléments de ton script.
Cependant sans le fichier ce n'est pas facile. Pourrais tu me le faire parvenir ?
La demande est ancienne pas sûr que tu regardes les réponses ... mais j'essaye quand même
cordialement
JP
 
Vote positif 0 Vote négatif

Discussions similaires

J
  • Résolu(e)
XL 2021 Envoi d'email et PJ en VBA
Réponses
3
Affichages
510
JPaul78
J
gothc
  • Question
XL 2019 erreur .send
Réponses
1
Affichages
488
Oneida
Oneida
C
  • Question
XL 2010 Probleme pour envoi d'un mail depuis excel avec gmail
Réponses
6
Affichages
2 K
chris66000
C
Xtian_Québec
  • Question
XL 2016 vba Envoi de courriel avec Gmail
Réponses
5
Affichages
5 K
kiki29
kiki29
G
  • Question
Microsoft 365 envoie feuille active avec excel par email
Réponses
0
Affichages
1 K
glfred
G
P
  • Question
XL 2019 Macro qui ralenti mon classeur après exécution
Réponses
2
Affichages
717
pat66
P
M
  • Question
XL 2013 Envoyer un mail automatique avec le contenu de la bonne ligne
Réponses
2
Affichages
777
Oneida
Oneida
L
  • Question
XL 2019 CDO.message et corps de mail
Réponses
2
Affichages
2 K
Hasco
Hasco
G
  • Question
Envoi mail avec pièce jointe
Réponses
2
Affichages
1 K
Gwendoline
G
jeromeN95
  • Question
XL 2013 envoie mail pdf chemin bureau Windows ??
Réponses
4
Affichages
1 K
fanch55
fanch55

Membres actuellement en ligne

5 membres et 109 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 628
Messages
2 111 333
Membres
111 104
dernier inscrit
JEMADA