Page 1 of 1

usando CDOSYS marca error, mail

Posted: Tue May 12, 2015 2:15 am
by noe aburto
saludos

Usando el ejemplo que expuso Manuel Mercado con el uso de envio de mail
me funciona perfecto en mi pc, pero en otras pc's con la misma version de windows no funciona, y me manda el aviso "NO SE PUDO ENVIAR EL MAIL"

Alguien podria indicarme que debo instalar en las pc's donde no funciona o que deberia configurar.

LAS FUNCIONES SON ESTAS

// --- Envio de correo electronico
Function SendEmail(cFrom,cTo,cBCC,cAttach,cSubject,cBody,cUser,cPass)
Local oDlg, aCtl[ 22 ], oFont
Local cMailServer := PadR( "smtp.gmail.com", 60 ) // servidor de correo
local nPort:=465 // puerto usado por el servidor de correo
local WS_3DLOOK:=4
local CLR_HBROWN:=RGB( 205, 192, 176 )
local CLR_NBLUE :=RGB( 142, 171, 194 )

default cFrom := PadR( "remitente@gmail.com", 60 ) // remitente
default cTo := PadR( "destinatario@hotmail.com", 180 ) // destinatario (uno o varios separados con comas)
default cBCC := Space( 180 ) // copias ocultas a (uno o varios separados con comas)
default cAttach := Space(180) // archivo anexo (uno o varios separados con comas)
default cSubject := Space( 60 ) // asunto
default cBody := Space( 500 ) // cuerpo del mensaje
default cUser := Space( 60 ) // nombre de usuario para autenticación
default cPass := Space( 30 ) // contraseña para autenticación

DEFINE FONT oFont NAME "Arial" SIZE 0, -16

DEFINE DIALOG oDlg FROM 0, 0 TO 455, 703 PIXEL ;
COLORS COLOR_AZUL, CLR_HBROWN ;
TITLE "Envio de Mail" ;
STYLE nOR( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, WS_3DLOOK )

@ 10, 5 SAYFWH aCtl[ 1 ] PROMPT "Servidor de Correo" OF oDlg ;
FONT oFont UPDATE ;
COLORS COLOR_AZUL, CLR_HBROWN SIZE 70, 11 PIXEL

@ 10, 80 GETFWH aCtl[ 2 ] VAR cMailServer OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS COLOR_AZUL, COLOR_BLANCO SIZE 206, 11 READONLY PIXEL

@ 10,294 SAYFWH aCtl[ 3 ] PROMPT "Puerto" OF oDlg ;
FONT oFont UPDATE ;
COLORS COLOR_AZUL, CLR_HBROWN SIZE 30, 11 PIXEL

@ 10,320 GETFWH aCtl[ 4 ] VAR nPort OF oDlg ;
FONT oFont UPDATE PICTURE "@K ####" ;
COLORS COLOR_AZUL, COLOR_BLANCO SIZE 24, 11 READONLY PIXEL

@ 24, 5 SAYFWH aCtl[ 5 ] PROMPT "Remitente" OF oDlg ;
FONT oFont UPDATE ;
COLORS COLOR_AZUL, CLR_HBROWN SIZE 70, 11 PIXEL

@ 24, 80 GETFWH aCtl[ 6 ] VAR cFrom OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS COLOR_AZUL, COLOR_BLANCO SIZE 264, 11 PIXEL

@ 39, 5 SAYFWH aCtl[ 7 ] PROMPT "Destinatario" OF oDlg ;
FONT oFont UPDATE ;
COLORS COLOR_AZUL, CLR_HBROWN SIZE 70, 11 PIXEL

@ 39, 80 GETFWH aCtl[ 8 ] VAR cTo OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS COLOR_AZUL, COLOR_BLANCO SIZE 264, 11 PIXEL

@ 54, 5 SAYFWH aCtl[ 9 ] PROMPT "Copia para" OF oDlg ;
FONT oFont UPDATE ;
COLORS COLOR_AZUL, CLR_HBROWN SIZE 70, 11 PIXEL

@ 54, 80 GETFWH aCtl[ 10 ] VAR cBCC OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS COLOR_AZUL, COLOR_BLANCO SIZE 264, 11 PIXEL

@ 69, 5 SAYFWH aCtl[ 11 ] PROMPT "Adjuntar" OF oDlg ;
FONT oFont UPDATE ;
COLORS COLOR_AZUL, CLR_HBROWN SIZE 70, 11 PIXEL

@ 69, 80 GETFWH aCtl[ 12 ] VAR cAttach OF oDlg PICTURE "@K" ;
FONT oFont UPDATE ;
COLORS COLOR_AZUL, COLOR_BLANCO SIZE 264, 11 PIXEL;
ACTION fAddAttach( aCtl[ 12 ] )

@ 84, 5 SAYFWH aCtl[ 13 ] PROMPT "Asunto" OF oDlg ;
FONT oFont UPDATE ;
COLORS COLOR_AZUL, CLR_HBROWN SIZE 70, 11 PIXEL

@ 84, 80 GETFWH aCtl[ 14 ] VAR cSubject OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS COLOR_AZUL, COLOR_BLANCO SIZE 264, 11 PIXEL

@ 99, 5 SAYFWH aCtl[ 15 ] PROMPT "Autenticación: Usuario" OF oDlg ;
FONT oFont UPDATE ;
COLORS COLOR_AZUL, CLR_HBROWN SIZE 80, 11 PIXEL

@ 99, 87 GETFWH aCtl[ 16 ] VAR cUser OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS COLOR_AZUL, COLOR_BLANCO SIZE 118, 11 PIXEL

@ 99,213 SAYFWH aCtl[ 17 ] PROMPT "Contraseña" OF oDlg ;
FONT oFont UPDATE ;
COLORS COLOR_AZUL, CLR_HBROWN SIZE 44, 11 PIXEL

@ 99,259 GETFWH aCtl[ 18 ] VAR cPass OF oDlg PASSWORD ;
FONT oFont UPDATE PICTURE "@K";
COLORS COLOR_AZUL, COLOR_BLANCO SIZE 85, 11 PIXEL

@117.5,6 SAYFWH aCtl[ 19 ] PROMPT "Cuerpo del mensaje" OF oDlg ;
SIZE 100, 11 PIXEL ;
FONT oFont COLORS COLOR_AZUL, CLR_HBROWN

@ 7,1.5 GET aCtl[ 20 ] VAR cBody OF oDlg ;
FONT oFont MULTILINE UPDATE ;
COLORS COLOR_AZUL, COLOR_BLANCO SIZE 42, 4.3

@11.5,5 BUTTON aCtl[ 21 ] PROMPT "&Enviar" OF oDlg ;
FONT oFont SIZE 53, 16 PIXEL ;
ACTION fSendMail( cMailServer, cFrom, cTo, cSubject, cBody, cAttach, cBCC, cUser, cPass, nPort )

@11.5,20 BUTTON aCtl[ 22 ] PROMPT "&Salir" OF oDlg ;
FONT oFont SIZE 53, 16 PIXEL ACTION oDlg:End()

ACTIVATE DIALOG oDlg CENTERED ;
VALID ( oFont:End(), .T. )

Return Nil



// --- Enviar un mail
Function fSendMail( cMailServer, cFrom, cTo, cSubject, cBody, cAttach, cBCC, cUser, cPass, nPort )

Local oCfg, oMsg, oError, nEle, cToken, bMens,;
lAuth := ! Empty( cUser ) .and. ! Empty( cPass ), ;
nSendOpt := 2 // send using: 1 = pickup folder 2 = port

memvar aAttach

Default nPort := 25, ;
cSubject := "", ;
cBody := ""

if !IsInternet()
aviso({'ATENCION','No existe conección a internet','Intente más tarde o verifique su problema'})
return .t.
endif

If "GMAIL.COM" $ Upper( cMailServer ) .and. ( Empty( cUser ) .or. Empty( cPass ) )
MsgStop( "Con GMail son requeridos nombre de usuario y contraseña", "Atención" )
Return .t.
EndIf

CursorWait()

bMens:=Mensaje('Para: '+cTo,'Espere, enviando un Mail')

aAttach:={}
if !Empty(cAttach)
cAttach:='{"'+StrTran(cAttach,',','","')+'"}'
aAttach:=cAttach
aAttach:=&(aAttach)
endif

nEle := 1

Try
oCfg := CreateObject( "CDO.Configuration" )

With Object oCfg:Fields
:Item( cdoSMTPServer ):Value := Trim( cMailServer )
:Item( cdoSMTPServerPort ):Value := nPort
:Item( cdoSendUsing ):Value := nSendOpt

If lAuth
:Item( cdoSMTPAuthenticate ):Value := 1
:Item( cdoSendUserName ):Value := Trim( cUser )
:Item( cdoSendPassword ):Value := Trim( cPass )
:Item( cdoSMTPUseSSL ):Value := 1

EndIf

:Update()
End With

oMsg := CreateObject( "CDO.Message" )

With Object oMsg
:Configuration := oCfg
:From := Trim( cFrom )
:To := Trim( cTo )
:Subject := Trim( cSubject )
:TextBody := Trim( cBody )

For nEle := 1 To Len( aAttach )
:AddAttachment := AllTrim( aAttach[ nEle ] )
Next

If ! Empty( cBCC )
:BCC := Trim( cBCC )
EndIf

:Send()
End With

Catch oError
CursorArrow()
Eval(bMens)
MsgStop( "No se pudo enviar el e-mail")
oCfg := Nil
oMsg := Nil
Return .t.
End Try

oCfg := Nil
oMsg := Nil
SndPlaySound( GetWinDir() + "\media\Tada.wav", 0 )
CursorArrow()

Eval(bMens)

Return .t.

Re: usando CDOSYS marca error, mail

Posted: Tue May 12, 2015 2:16 pm
by derpipu
Amigo, quita el Try Catch y veras el error a detalle..., algunas veces es el correo mal escrito, o las configuraciones o el archivo a adjuntar no existe...

Y nos dices...

Re: usando CDOSYS marca error, mail

Posted: Tue May 12, 2015 11:44 pm
by noe aburto
Bien, lo hare, y estamos en contacto.

Re: usando CDOSYS marca error, mail

Posted: Wed May 13, 2015 3:14 am
by J. Ernesto
Noe, mira ypega el siguiente código para que veas el tipo de error:

Code: Select all

CATCH oError
 Error_Envio ( oError, "CDO.Message" )
 Return ( .F. )
END

Return ( .T. )
* -------------------------------------------------------------------------------------------------------------- *

* -------------------------------------------------------------------------------------------------------------- *
Function Error_Envio ( oError, cViene )

 MsgInfo ( "Error envio de EMail! " + cViene                         + CRLF + ;
           "Error: "     + TRANSFORM ( oError:GenCode,   NIL ) + ";" + CRLF + ;
           "SubC: "      + TRANSFORM ( oError:SubCode,   NIL ) + ";" + CRLF + ;
           "OSCode: "    + TRANSFORM ( oError:OsCode,    NIL ) + ";" + CRLF + ;
           "SubSystem: " + TRANSFORM ( oError:SubSystem, NIL ) + ";" + CRLF + ;
           "Mensaje: "   + oError:Description, "Atención" )

Return ( NIL )
* -------------------------------------------------------------------------------------------------------------- *
 
y nos cuentas

Saludos....

Re: usando CDOSYS marca error, mail

Posted: Mon Aug 10, 2015 4:59 pm
by rterraz
Hola Amigos

Para que el ejemplo de CDOSYS mail, funcione correctamente se debe corregir una linea del codigo que esta mal escrita
esto es lo que dicce en el PRG:

For nEle := 1 To Len( aAttach )
:AddAttachment := AllTrim( aAttach[ nEle ] )
Next

el error se produce al tratar de adjuntar archivos porque esta mal escrito el argumento de :AddAttachment()
DEBE DECIR:
For nEle := 1 To Len( aAttach )
:AddAttachment( AllTrim( aAttach[ nEle ] ))
Next


un saludo a todos.