Function EnviaMailCDO(aDestinos, cAsunto, cTexto, aAdjuntos, aCC, aBcc, lRespuesta )
Local oEmailCfg, oEmailMsg, oError, nFor, i, loBP
local cDatos := GetSysDir(), oIni, nDefecto := 1
local cIniFile := cDatos+"\PREFEREN.INI"
Local lEncriptaPass := .f. //GetPvProfString("CORREO","EncriptaPass" ,.f., cIniFile)
Local cServer := "" //GetPvProfString("CORREO","servidor" ,"", cIniFile)
Local nPortEmail := "25" //VAL(GetPvProfString("CORREO","Puerto","25", cIniFile))
Local cEmailFrom := "" //GetPvProfString("CORREO","Remitente" ,"", cIniFile)
Local cEmailUser := "" //GetPvProfString("CORREO","Usuario" ,"", cIniFile)
Local cEmailPass := "" //GetPvProfString("CORREO","Contra" ,"", cIniFile)
Local lEmailSSL := .f. //GetPvProfString("CORREO","SSL" , .f., cIniFile)
local lAutentificar := .t.
local nTiempo := "30"
local cLogo := ""
local cFirma := ""
DEFAULT aAdjuntos:= {}
DEFAULT cAsunto :=""
DEFAULT cTexto := ""
if Empty(aDestinos ) .or. !("@"$aDestinos[1])
msgStop("Es necesario indicar al menos un destinatario.", "Aviso")
Return .f.
endif
if !empty( aAdjuntos )
for nFor = 1 to LEN(aAdjuntos)
if !file( aAdjuntos[nFor] )
MsgStop("No existe el archivo para adjuntar:"+CRLF+;
aAdjuntos[nFor], "Problema" )
return .f.
endif
next nFor
endif
INI oIni FILE RutaIniDatos()+"\MAILJVBP.INI"
GET nDefecto SECTION "CORREO" ENTRY "CuentaDefecto" OF oIni
ENDINI
INI oIni FILE cDatos+"\PREFEREN.INI"
GET cServer SECTION "CORREOCDO_CUENTA"+str(nDefecto, 1) ENTRY "Servidor" OF oIni
GET cEmailFrom SECTION "CORREOCDO_CUENTA"+str(nDefecto, 1) ENTRY "Remitente" OF oIni
GET cEmailUser SECTION "CORREOCDO_CUENTA"+str(nDefecto, 1) ENTRY "Usuario" OF oIni
GET cEmailPass SECTION "CORREOCDO_CUENTA"+str(nDefecto, 1) ENTRY "Contra" OF oIni
GET nTiempo SECTION "CORREOCDO_CUENTA"+str(nDefecto, 1) ENTRY "Tiempo" OF oIni DEFAULT "30"
GET nPortEmail SECTION "CORREOCDO_CUENTA"+str(nDefecto, 1) ENTRY "Puerto" OF oIni DEFAULT "25"
GET lEncriptaPass SECTION "CORREOCDO_CUENTA"+str(nDefecto, 1) ENTRY "EncriptaPass" OF oIni DEFAULT .t.
GET lAutentificar SECTION "CORREOCDO_CUENTA"+str(nDefecto, 1) ENTRY "Autentificar" OF oIni DEFAULT .t.
GET lEmailSSL SECTION "CORREOCDO_CUENTA"+str(nDefecto, 1) ENTRY "SSL" OF oIni DEFAULT .f.
GET cLogo SECTION "CORREOCDO_CUENTA"+str(nDefecto, 1) ENTRY "Logo" OF oIni
GET cFirma SECTION "CORREOCDO_CUENTA"+str(nDefecto, 1) ENTRY "FirmaTxt" OF oIni
ENDINI
if empty(cServer) .or. empty(cEmailFrom)
MsgStop("Debe configurar previamente los datos del correo.", "Aviso")
return .f.
endif
cLogo := alltrim(cLogo)
cFirma := alltrim(cFirma)
cTexto := ConvHTML(cTexto, cLogo, cFirma)
nTiempo := VAL(nTiempo)
nPortEmail := VAL(nPortEmail)
cEmailPass := iif(lEncriptaPass, PADR(DECRYPT(cEmailPass) , 75, " "), PADR(cEmailPass , 75, " "))
cEmailPass := ALLTRIM(cEmailPass)
TRY
oEmailCfg := CREATEOBJECT( "CDO.Configuration" )
WITH OBJECT oEmailCfg:Fields
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value := cServer //"smtp.fibertel.com.ar" //"smtp.live.com" ///"smtp.gmail.com"
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value := nPortEmail //25 //465
:Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value := 2 // Remote SMTP = 2, local = 1
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value := lAutentificar
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ):Value := lEmailSSL
:Item( "http://schemas.microsoft.com/cdo/configuration/sendusername" ):Value := cEmailUser
:Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword" ):Value := cEmailPass
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"):Value := nTiempo
:Update()
END WITH
CATCH oError
MsgInfo( "Error al configurar el correo" + 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 + ;
"Message: " + oError:Description, "Error de configuracion CDO" )
END
oError:=NIL
for nFor = 1 to LEN(aDestinos)
TRY
oEmailMsg := CREATEOBJECT ( "CDO.Message" )
WITH OBJECT oEmailMsg
:Configuration = oEmailCfg
//:From = chr(34)+'jvbp '+chr(34) + '<'+cEmailFrom+'>' // This will be displayed in the From (The email id does not appear)
:From = cEmailFrom // remitente
:To = aDestinos[nFor] // destinatarios
iif(!empty(aCC) , :Cc = aCC , ) // con copia
iif(!empty(aBcc), :BCC = aBCC, ) // con copia oculta
:Subject = cAsunto // sujeto
//:TextBody = cTexto // formato Texto
//:CreateMHTMLBody("file:///E:\prueba.htm", 0) //[, flags [, username, password]] // envia una pagina HTML ya creada
:AutoGenerateTextBody = .T. // cuando el cliente no acepta HTML genera un formato de texto
:HTMLBody = cTexto // formato HTML
iif(!empty(cLogo), loBP:=:AddRelatedBodyPart( cLogo, "id_imagen1", 0), )
for i = 1 to len(aAdjuntos)
:AddAttachment(aAdjuntos[i]) // adjuntos
next i
if lRespuesta
:MDNRequested = .T. // Requiere respuesta
:fields( "urn:schemas:mailheader:disposition-notification-to" ):Value := cEmailFrom
:fields( "urn:schemas:mailheader:return-receipt-to" ):Value := cEmailFrom
:fields:Update()
endif
:Send()
END WITH
CATCH oError
MsgInfo("Error al enviar el mensaje" + 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 +;
"Message: " + oError:Description, "Error al enviar el mensaje" )
return .f.
END
next nFor
Return .T.
Posted: Wed Dec 06, 2017 2:20 pm
