Problemas con envio de correos CDO
Publicado por Tito Alomia (1 intervención) el 15/10/2015 18:16:40
Hola a todos desde hace unos dias se me ha venido presentado un problema con el envio de correos desde vfp con el control CDO, alguien sabe que puede estar pasando? Sale un erro de transporte el siguiente es el codigo:
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
67
68
69
70
71
72
=enviaremail("************@gmail.com","*****************","************@hotmail.com","Prueba de correo","tttttttttttt","")
Procedure ENVIAREMAIL
LParameters EmailRemitente, Contrasena, EmailDestinatario, Titulo, Texto, ArchivosAdjuntos
* URL: http://www.portalfox.com/index.php?name=News&file=article&sid=2626&mode=nested&order=0&thold=0
if Empty(ArchivosAdjuntos)
Wait Window "Estoy tratando de enviar el e-mail a: " + EmailDestinatario NoWait
else
Wait Window "Estoy tratando de enviar el e-mail a: " + EmailDestinatario + ". Paciencia, esto puede tardar varios minutos..." NoWait
endif
Try
Local Esquema, oCDO, oMsg, oError
Esquema = "http://schemas.microsoft.com/cdo/configuration/"
oCDO = CreateObject("CDO.Configuration")
with oCDO.Fieldsdo case
case "GMAIL" $ Upper(EmailRemitente)
.Item(Esquema + "smtpserver") = "smtp.gmail.com"
.Item(Esquema + "smtpserverport") = 465
.Item(Esquema + "sendusing") = 2
.Item(Esquema + "smtpauthenticate") = .T.
.Item(Esquema + "smtpusessl") = .T.
case "HOTMAIL" $ Upper(EmailRemitente)
.Item(Esquema + "smtpserver") = "smtp.live.com"
.Item(Esquema + "smtpserverport") = 25
.Item(Esquema + "sendusing") = 2
.Item(Esquema + "smtpauthenticate") = .T.
.Item(Esquema + "smtpusessl") = .T.
case "YAHOO" $ Upper(EmailRemitente)
.Item(Esquema + "smtpserver") = "smtp.mail.yahoo.com"
.Item(Esquema + "smtpserverport") = 25
.Item(Esquema + "sendusing") = 2
* .Item(Esquema + "smtpauthenticate") = .T.
* .Item(Esquema + "smtpusessl") = .T.
otherwise
Wait Window "No puedo enviar este e-mail. No conozco los parámetros necesarios del servidor de correo"endcase
.Item(Esquema + "sendusername") = EmailRemitente
.Item(Esquema + "sendpassword") = Contrasena
.Update()
endwith
oMsg = CreateObject("CDO.Message")
with oMsg
.Configuration = oCDO
.From = EmailRemitente
.To = EmailDestinatario
.Subject = Titulo
.TextBody = Texto
if !Empty(ArchivosAdjuntos)
.AddAttachment(ArchivosAdjuntos)
* .AddAttachment() && Hay que agregar una línea AddAttachment() por cada archivo adjunto
endif
.Fields("urn:schemas:mailheader:disposition-notification-to") = .From
.Fields("urn:schemas:mailheader:return-receipt-to") = .From
.Fields.Update
.Send()
Wait Window 'El e-mail con título: "' + AllTrim(Titulo) + '" fue enviado exitosamente.'
endwith
catch to oError
=MessageBox("No pudo enviarse el e-mail" + Chr(13) + "Error Nº: " + Transform(oError.ErrorNo) + Chr(13) + "Mensaje: " + oError.Message)
finally
Release oCDO, oMsgoCDO = .NULL.
oMsg = .NULL.
endtry
Return
**Valora esta pregunta
0