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

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:
C

Compte Supprimé 979

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

Bonjour Zephir94

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)
Normal, en réseau d'entreprise tu dois passer par un Proxy et ce genre de code bloque

J'ai fait beaucoup de recherche et pas trouvé grande réponses !
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:

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:

JP.B

XLDnaute Nouveau
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
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