Problème avec un proxy et CDO
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:
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
1 ere solution pour connaitre son smtp
purré j'suis en forme ce soir !!
teste ca chez toi et au boulot
Code:
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> </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 |
;)
