Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » FoxPro/Visual FoxPro » Problemas con envio de correos CDO

FoxPro/Visual FoxPro - Problemas con envio de correos CDO

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil

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.Fields
      do 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, oMsg
    oCDO = .NULL.
    oMsg = .NULL.
  endtry
 
Return
*
*
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder