Problème avec un proxy et CDO

**scoubi77** · 22/06/2015, 16h39

Bonjour à tous,

J'ai écris ce code mais je n'arrive pas à passer le proxy du réseau ou je dois installer mon fichier !
j'ai comme erreur :

Run-time error ‘-2147220973(8004123)’
“The Transport failed to connect to server”

J'ai fouillé un peu les lieux et je me suis aperçu qu'en fait il y a une sorte de script comme proxy du genre :
" http://pac.fr.*******.com/proxysaas.pac" , le port est : 80

Voici mon code :

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
Sub Mail ()
     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/urlproxyserver") = "proxy.server:80" 
       .Item("http://schemas.microsoft.com/ cdo/configuration/urlproxybypass") = "<local>"
       .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

Si quelqu'un à un idée je suis preneur !
Evidement chez moi ça fonctionne au poils !
Il n'y a pas Outlook donc c'est pour cela que je suis passé par la méthode CDO, y a-t-il une autre méthode à part ouvrir une page Google chrome Gmail et remplir les champs manuellement !
rien que l'idée me fait trembler !

Par avance merci à vous tous

**patricktoulon** · 22/06/2015, 18h13

Bonjour
woaouh!!! tu va chercher loin c'est pas la peine tout ca !!!!

essaie celui la en change les adresse mail bien sur en début de macro et met le nom du serveur smtp de ton F A I mais pas celui de ta boite mail (exemple chez moi c'est orange donc smtp.orange.fr)

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
Sub sending_mail_CDO()
    Dim iMsg As Object, iConf As Object, Flds As Object, serveur, destinataire, emetteur, sujet
    serveur = "smtp.orange.fr"
    destinataire = "destnataire@hotmail.fr"
    emetteur = "moi@live.com"
    sujet = "titre du mail"

Set iMsg = CreateObject("cdo.message")
    Set iConf = CreateObject("cdo.configuration")
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        'remplacez "serveur" par le nom de serveur smtp de votre FAI si vous utilisez pas la variable serveur
        'http://outlook.developpez.com/faq/index.php?page=Configuration#Paras_FAI
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = serveur
        .Update
    End With
    With iMsg
        Set .Configuration = iConf
        .To = destinataire
        .From = emetteur
        .Subject = sujet
        .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."
 
        ' .AddAttachment 'c:\mon dossier\monfichier.extention"
        .Send
    End With

**scoubi77** · 22/06/2015, 18h28

Bonsoir Patricktoulon,

Merci pour ta réponse,

J'ai dû mal m'exprimer, mon code fonctionne parfaitement chez moi !
en revanche je dois l'installer sur le réseau de mon travail qui a un proxy, là est mon soucis car je n'arrive pas à le dépasser.
Nous n'avons pas Outlook d'installé si non je serais passé par cet objet.

Dès que mon code arrive à .send au bout de 30s j'ai un message d'Excel m'indiquant l'erreur que j'ai mentionné dans mon premier message.
Le fait de changer de FAI ne fera pas évoluer mon soucis, car nous travaillons avec Gmail et ce n'est pas lui qui est en cause mais le proxy
Merci pour ta proposition, une autre idée ?

Bien cordialement

scoubi

**patricktoulon** · 22/06/2015, 18h37

alors je repete doucement

esaie mon code a ton boulot tel quel!!!!!!!! avec le bon smtp

point barre!!!!!

**scoubi77** · 22/06/2015, 18h43

Merci pour cette précision,

Nous utilisons Gmail comme boite mail mais aucune idée pour le FAI ! c'est une structure nationale !
comment faire pour trouver cette info, notre BSI est pire que le KGB aucune info ne sort de ce bureau lol

**patricktoulon** · 22/06/2015, 19h04

alors la je ne peut pas le savoir a ta place

je crois qu'il existe des macros j'ai déjà vu ca pour tester le smpt en retour mais je ne sais plus ou. je vais chercher

**scoubi77** · 22/06/2015, 19h35

Merci à toi

**patricktoulon** · 22/06/2015, 19h48

purré j'suis en forme ce soir !!

teste ca chez toi et au boulot

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
Function serveur_smtp()
Dim Req As Object, url As String
url = "http://www.libellules.ch/ip.php"
Set Req = CreateObject("microsoft.xmlhttp")
Req.Open "POST", url, False
'Req.SetRequestheader "Accept-Language", "fr-FR"
'Req.SetRequestheader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
'Req.SetRequestheader "Accept-Encoding", "gzip, deflate"
'Req.SetRequestheader "Host", "www.libellules.ch"
'Req.SetRequestheader "DNT", 1
'Req.SetRequestheader "Connection", " Keep - Alive"
Req.send
serveur_smtp = Split(Req.responsetext, "<p>&nbsp;</p>")(1)
serveur_smtp = "smtp." & Split(Split(Split(serveur_smtp, "<p><b>Fournisseur d'ac")(1), "www.")(1), ")")(0)
End Function
Sub test()
MsgBox "mon serveur SMTP est : " & serveur_smtp
End Sub

**scoubi77** · 22/06/2015, 20h19

Je viens de tester un grand merci à toi.

Demain je test sur le proxy et reviens te dire, en attendant je te souhaite une excellente soirée.

**patricktoulon** · 22/06/2015, 20h25

ca donne bien
"smtp.quelquechose.fr ????

**scoubi77** · 22/06/2015, 20h30

Tout à fait là je suis chez moi donc j'ai mon FAI, demain j'éprouve cela sur le proxy

et je vais essayer ton code

**patricktoulon** · 22/06/2015, 20h37

je compte sur toi pour me donner un retour affirmatif ou négatif

car si tu a regardé dans ma signature en bas de mes post tu comprendra que c'est un sujet qui m'intéresse

et pouvoir intégrer cette petite fonction dans mes exercices existants leur donneront un transportabilité (plus besoins de coder le serveur )

merci a toi de m'avoir donner ce petit os a ronger

**scoubi77** · 23/06/2015, 18h50

Bonsoir comme promis voici un retour.

Je pense que ton programme fonctionne bien mais il n'a pas réussi à déterminer le smtp de mon travail.
Je suis donc aller tester avec le site libellule.ch et lui aussi ne trouve pas le smtp il le classe en inconnu, donc la protection est vraiment très efficace !

Jeudi je vais le tester dans une autre structure et je te dirais jeudi soir !
Merci pour ton aide à jeudi soir.

**patricktoulon** · 23/06/2015, 19h35

ok merci pour le retour

**panthera26** · 19/04/2018, 14h43

Bonjour j ai ma macro qui marche sur mon ordi perso mais au travail ne marche pas
il est envoyé par mail port 465

comment ca se fait
sur mon ordi perso si je met 567 au lieu de 465 j ai le meme message d erreur

Problème avec un proxy et CDO

Macros et VBA Excel

Discussions similaires

Partager

Partager