FoxPro/Visual FoxPro - Email

Gracias por la ayuda respecto a sistema multisuario, he hecho los cambios sugeridos y lo estan probando a ver como va.

Tengo otro tema que me causa problemas.

En un formulario envio email, para lo cual consegui una rutina que toma un
objeto MSMAPI, el problema es el siguiente.

Este funciona bien si esta bien configurado el OutLook, de lo contrario da
errores y se cancela el ejecutable. Como mi programa es en Red, no todos
los usuarios tienen bien configuardo el OutLook. y a la mayoria les da error

No conozco mucho del Outlook, como para poder configurarlo bien , necisito crear
una cuenta con un correo, por ahi me complico. Derrepente hay otra manera de
envio de email sin utilizar el OutLook, si tuvieran algo de eso les agradeceria
enormente o diganme donde puedo bajar u observar un formulario ejemplo.
estoy con VFP6.0

Nuevamente Gracias.

Prueba esto


*******************************
*!* Ejemplo de utilización de SendViaMAPI
*******************************
DIMENSION aryAttach(2)
aryAttach(1) = "C:\attachment1.txt" && cambie a un archivo real que existe en su PC
aryAttach(2) = "C:\attachment2.zip" && cambie a un archivo real que existe en su PC
LOCAL lcTo, lcSubject, lcBody, lnCount, lcCC, lcBCC, lcUserName, lcPassword, llOpenEmail, lcErrReturn
lcTo = "[email protected]"
lcSubject = "¿Ha intentado enviar un email con VFP?"
lcBody = "Quiero hacerle saber que VFP es muy versátil" + CHR(13) + "y hay muchas formas de enviar un email."
lcCC = "[email protected]"
lcBCC = "[email protected]"
lcUserName = "[email protected]" && mi nombre de usuario SMTP
lcPassword = "Mi_PaSsWoRd" && mi contraseña SMTP
*!* para enviar correo automáticamente haga llOpenEmail igual a .F.
llOpenEmail = .T. && Si el correo se abrió o no, en el cliente de correo MAPI
SendViaMAPI(@lcErrReturn, lcTo, lcSubject, lcBody, @aryAttach, lcCC, lcBCC, lcUserName, lcPassword, llOpenEmail)
IF EMPTY(lcErrReturn)
MESSAGEBOX("'" + lcSubject + "' se envió satisfactoriamente.", 64, "Envía email via MAPI")
ELSE
MESSAGEBOX("'" + lcSubject + "' falló al enviar. Causa:" + CHR(13) + lcErrReturn, 64, "Envía email via MAPI")
ENDIF

*******************************************
PROCEDURE SendViaMAPI(tcReturn, tcTo, tcSubject, tcBody, taFiles, tcCC, tcBCC, tcUserName, tcPassword, tlOpenEmail)
*******************************************
#DEFINE PRIMARY 1
#DEFINE CARBON_COPY 2
#DEFINE BLIND_CARBON_COPY 3
LOCAL loSession, loMessages, lnAttachments, loError AS EXCEPTION, loErrorSend AS EXCEPTION
tcReturn = ""
TRY
loSession = CREATEOBJECT( "MSMAPI.MAPISession" )
IF TYPE("tcUserName") = "C"
loSession.UserName = tcUserName
ENDIF
IF TYPE("tcPassword") = "C"
loSession.PASSWORD = tcPassword
ENDIF
loSession.Signon()
IF (loSession.SessionID > 0)
loMessages = CREATEOBJECT( "MSMAPI.MAPIMessages" )
loMessages.SessionID = loSession.SessionID
ENDIF
WITH loMessages
.Compose()
.RecipDisplayName = tcTo
.RecipType = PRIMARY
.ResolveName()
IF TYPE("tcCC") = "C"
.RecipIndex = .RecipCount
.RecipDisplayName = tcCC
.RecipType = CARBON_COPY
.ResolveName()
ENDIF
IF TYPE("tcBCC") = "C"
.RecipIndex = .RecipCount
.RecipDisplayName = tcBCC
.RecipType = BLIND_CARBON_COPY
.ResolveName()
ENDIF
.MsgSubject = tcSubject
.MsgNoteText = tcBody
IF TYPE("taFiles", 1) = "A"
lnAttachments = ALEN(taFiles)
IF LEN(tcBody) < lnAttachments && Se asegura que el cuerpo es suficientemente grande para los adjuntos
tcBody = PADR(tcBody, lnAttachments, " ")
ENDIF
FOR lnCountAttachments = 1 TO lnAttachments
.AttachmentIndex = .AttachmentCount
.AttachmentPosition = .AttachmentIndex
.AttachmentName = JUSTFNAME(taFiles(lnCountAttachments))
.AttachmentPathName = taFiles(lnCountAttachments)
ENDFOR
ENDIF
TRY
.SEND(tlOpenEmail)
CATCH TO loErrorSend
IF tlOpenEmail && El usuario canceló la operación desde su cliente de correo?
tcReturn = "El usuario canceló el envío de correo."
ELSE
THROW loErrorSend
ENDIF
ENDTRY
ENDWITH
loSession.Signoff()
CATCH TO loError
tcReturn = [Error: ] + STR(loError.ERRORNO) + CHR(13) + ;
[LineNo: ] + STR(loError.LINENO) + CHR(13) + ;
[Message: ] + loError.MESSAGE + CHR(13) + ;
[Procedure: ] + loError.PROCEDURE + CHR(13) + ;
[Details: ] + loError.DETAILS + CHR(13) + ;
[StackLevel: ] + STR(loError.STACKLEVEL) + CHR(13) + ;
[LineContents: ] + loError.LINECONTENTS
FINALLY
STORE .NULL. TO loSession, loMessages
RELEASE loSession, loMessages
ENDTRY
ENDPROC

Suerte

Que tal Ernesto, he probado este ejemplo y corro el programa y funciona de maravilla, pero al mandar llamar el mismo programa desde una forma obviamente enviandole las variables necesarias no me funciona, marca el siguiente error:

Error: 1429
LineNo: 60
Message: OLE IDispatch exception code 0 from MAPIMessages: Unknown recipent..
Procedure: sendviamapi
Details: OLE IDispatch exception code 0 from MAPIMessages: Unknown recipent.
StackLevel: 4
LineContents: .ResolveName()

Segun lo que leo es algo como si estuviera mal el mail destinatario, pero ya lo cheque y esta bien ya que es el mismo que utilizo cuando lo ejecuto como programa.

sabes que podria ser? gracias

Esta es otra forma ... cooperacion de uno de los gurus de VFP Craig Boyd

*******************************
*!* Ejemplo de utilización de SendViaShell
*******************************
LOCAL lcTo, lcSubject, lcBody, lcCC, lcBCC, lcErrReturn
lcTo = "[email protected]"
lcSubject = "Ha intentado enviar un email con VFP?"
lcBody = "Quiero hacerle saber que VFP es muy versátil" + CHR(13) + "y hay muchas formas de enviar un email."
lcCC = "[email protected]"
lcBCC = "[email protected]"
SendViaShell(@lcErrReturn, lcTo, lcSubject, lcBody, lcCC, lcBCC)
IF EMPTY(lcErrReturn)
MESSAGEBOX("'" + lcSubject + "' se envió satisfactoriamente.", 64, "Enviar email vía Shell")
ELSE
MESSAGEBOX("'" + lcSubject + "'falló al enviar. Causa:" + CHR(13) + lcErrReturn, 64, ;
"Enviar email vía Shell")
ENDIF

*******************************************
PROCEDURE SendViaShell(tcReturn, tcTo, tcSubject, tcBody, tcCC, tcBCC)
*******************************************
DECLARE INTEGER ShellExecute IN shell32.DLL ;
INTEGER hwndWin, STRING cOperation, STRING cFile, ;
STRING cParameters, STRING cDirectory, INTEGER nShowWin
LOCAL lcCommand, lcCRLF

TRY
lcCRLF = "%0D%0A"
lcCommand = "mailto:" + tcTo + "?Subject=" + tcSubject + "&Body=" + STRTRAN(tcBody, CHR(13), lcCRLF)
IF TYPE("tcCC") = "C"
lcCommand = lcCommand + "&CC=" + tcCC
ENDIF
IF TYPE("tcBCC") = "C"
lcCommand = lcCommand + "&BCC=" + tcBCC
ENDIF
IF LEN(lcCommand) > 2020 && debía ser 2048, pero no en mi sistema
THROW "El comando Mailto está limitado a 2048 bytes"
ENDIF
ShellExecute(0, "open", lcCommand, "", "", 1)
CATCH TO loError
tcReturn = [Error: ] + STR(loError.ERRORNO) + CHR(13) + ;
[LineNo: ] + STR(loError.LINENO) + CHR(13) + ;
[Message: ] + loError.MESSAGE + CHR(13) + ;
[Procedure: ] + loError.PROCEDURE + CHR(13) + ;
[Details: ] + loError.DETAILS + CHR(13) + ;
[StackLevel: ] + STR(loError.STACKLEVEL) + CHR(13) + ;
[LineContents: ] + loError.LINECONTENTS
FINALLY
CLEAR DLLS "ShellExecute"
ENDTRY
ENDPROC

Suerte