Cómo Crear y enviar Archivo.PDF de forma Automática

Hola, buen día Alonso,
Estoy tratando de hacer los siguiente:
Mi formulario genera un Reporte FRX y ademas permite exportarlo a PDF con PDFCreator, esto lo hace abriendo la pantalla Imprimir donde puedo elegir entre imprimir directamente a una impresora o a un archivo pdf, el nuevo requerimiento es:
Enviar este reporte con formato .PDF directamente a una dirección de correo, mi formulario tiene asociado una dirección de correo electrónico de un cliente, el remitente es quien está ejecutando el sistema. La idea es: que el archivo se envíe de forma automática sin la intervención del usuario, es decir, asignar el nombre del reporte, elegir el destinatario desde la base de datos, elegir el remitente de la base de datos, agregar el asunto y hecho!
He considerado hacerlo de esta manera:
1.- Convertir el Reporte.FRX a Reporte.PDF y guardarlo en una carpeta
2.- Ejecutar el envío, pasando los parámetros requeridos.
Lo que he encontrado:
Encontré algo sobre una función para hacer la conversión, y para hacer el envío, pero no le llego, no se como crear la función,
Muchas gracias y Saludos.

1 respuesta

1
Respuesta de
¿Qué es lo que encontraste acerca de hacer el envío?
Saludos Alonso, lo que encontré es convertir el Archivo.FRX a Archivo.PDF y algo de código para enviar por correo archivos desde Foxpro :
*----------------------------------------------------------------
*---------Función para convertir frx a pdf automatización--------
*--recibe nombre reporte, nombre archivo pdf, ubicación del pdf--
*----------------------------------------------------------------
FUNCTION ImpPdf
PARAMETERS lcRepo, lcPdf, lcUbi
=proclase()
DECLARE Sleep IN WIN32API INTEGER
ReadyState = 0 && Variable indiquant que l'imprimante n'est pas prête
PDFCreator = CREATEOBJECT("PDFCreator.clsPDFCreator")
PDFReady = CREATEOBJECT("PDFEvent") && Voir définition de la classe plus bas
EVENTHANDLER(PDFCreator,PDFReady)
WITH PDFCreator
* Démarrer sans lancer les travaux :
.cStart ("/NoProcessingAtStartup")
* Options de sauvegarde :
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = "&lcUbi"
.cOption("AutosaveFilename") = lcPdf
.cOption("AutosaveFormat") = 0 && 0 pour le format PDF
* Modification temporaire de l'imprimante par défaut :
DefaultPrinter = .cDefaultprinter
.cDefaultprinter = "PDFCreator"
.cClearcache
ENDWITH
REPORT FORM &lcRepo TO PRINTER NOCONSOLE
* Lancement de l'impression :
PDFCreator.cPrinterStop = .F.
* On attend jusqu'à ce que l'imprimante soit prête ou que 10 secondes se
soient écoulées :
c = 0
DO WHILE (ReadyState = 0) AND (c < 10)
c = c + 1
Sleep (500)
enddo
PDFCreator.cDefaultprinter = DefaultPrinter
Sleep (200)
PDFCreator.cClearcache
PDFCreator.cClose
RELEASE PDFCreator
RELEASE PDFReady
endfunc
PROCEDURE proclase
*--------------------------------------------
* Définition de la classe gérant les événements :
DEFINE CLASS PDFEvent AS Custom
IMPLEMENTS __clsPDFCreator IN "PDFCreator.clsPDFCreatorOptions"
* Evénement qui indique si l'imprimante est prête
PROCEDURE __clsPDFCreator_eReady() AS VOID
ReadyState = 1
ENDPROC
* Gestion des erreurs
PROCEDURE __clsPDFCreator_eError() AS VOID
ENDPROC
ENDDEFINE
=imppdf(Mireporte, NombrePDF, Destino)
*************************************************************
LOCAL lcPerfil AS CHARACTER, lcContrasenia AS CHARACTER , ;
lcDestinatario AS CHARACTER, lcTema AS CHARACTER , ;
lcCuerpo AS CHARACTER
LOCAL loOutlook AS "Outlook.Application", ;
loNameSpace AS OBJECT, loMailItem AS OBJECT
#DEFINE LF_CR CHR(10)+CHR(13)
*-- Datos del Mail
lcPerfil = "Prueba"
lcContrasenia = "prueba"
lcDestinatario = "(xxxxxx)"
lcTema = "Prueba: " + TTOC(DATETIME())
lcCuerpo = "Prueba enviando un mail desde Visual FoxPro." + LF_CR
lcCuerpo = lcCuerpo + "Saludos." + LF_CR
*-- Creo objetos Outlook y NameSpace
loOutlook = CREATEOBJECT("Outlook.Application")
loNameSpace = loOutlook.GetNameSpace("MAPI")
*-- Ejecuto los métodos
loNameSpace.Logon(lcPerfil , lcContrasenia)
loMailItem = loOutlook.CreateItem(0)
loMailItem.Recipients.ADD(lcDestinatario)
loMailItem.Subject = lcTema
loMailItem.Body = lcCuerpo
loMailItem.Send
loNameSpace.Logoff
loNameSpace = .NULL.
loOutlook = .NULL.
Este código está hecho para enviar un archivo a un correo a través del Messenger, ensaya con esto tal vez te sirva de ayuda:
Procedure SendFile
  LParameters lcContact, lcFile
  * Este método no está representado como un UI alterno al Messenger,
* representa un demostración de la API del Messenger a la que puede
* acceder por vía Modelo de Objetos Componentes (COM). Usted puede
* usar estos métodos para enviar mensajes instantáneos automatizados,
* correo o archivos a cualquier usuario del MSN desde sus procesos
* automatizados. Adicionalmente, si ese usuario ha establecido mensajería
* móvil, el correo será enviado a su dispositivo móvil.
  Local lcExc As Exception
  Local lcMessengerObject, lcWsh, lcSendFileWindow
  Try
    lcMessengerObject = Createobject("Messenger.UIAutomation.1")
    lcWsh = Createobject("wscript.Shell")
    Catch To lcExc
        If Vartype(lcMessengerObject) <> "O" Then
            Messagebox("Ha ocurrido un error al cargar Windows Messenger." + Chr(13);
            + "Asegúrese que tenga instalado Windows Messenger 4.7" + Chr(13);
            + "o una versión reciente de este programa.", 32, "Enviar archivo")   
        Return .F.                
          Else
              Messagebox(lcExc.Message, 16, "Enviar mensaje")
        Endif
  Endtry
  Try
    lcSendFileWindow = lcMessengerObject.SendFile(lcContact, lcFile)
    SendKeys("{Enter}", .F., lcWsh)
    lcSendFileWindow.Close
    lcSendFileWindow = Null
    Catch To lcExc
      GetOleError(lcExc)
  Endtry
Endproc 
Procedure SendKeys
  Lparameters KeyValues, lcIsLiteral, lcWsh
  Local i. lcChar, lcKeys
  If Vartype(lcWsh) = "O"
    If lcIsLiteral
      lcKeys = ""
        For i = 1 To Len(KeyValues)
          lcChar = Substr(KeyValues, i, 1)
          Do Case
            Case lcChar = "{"
                lcKeys = lcKeys + "{{}"
              Case lcChar = "}"
                  lcKeys= lcKeys + "{}}"
              Otherwise
                  lcKeys = lcKeys + lcChar
          Endcase      
        Endfor   
        KeyValues = lcKeys   
        KeyValues = Strtran(KeyValues,"^","{^}")
        KeyValues = Strtran(KeyValues,"+","{+}")
        KeyValues = Strtran(KeyValues,"%","{%}")
        KeyValues = Strtran(KeyValues,"~","{~}")
        KeyValues = Strtran(KeyValues,"[","{[}")
        KeyValues = Strtran(KeyValues,"]","{]}")
      Endif      
    lcWsh.SendKeys(KeyValues)
  Endif
Endproc
Procedure GetOleError
  Parameters lcException
  #DEFINE MSGR_E_ALREADY_LOGGED_ON Val("0x81000304")
  #DEFINE MSGR_E_NOT_LOGGED_ON           Val("0x8100031e")
  #DEFINE E_INVALIDARG                   Val("0x81000304")
  #DEFINE MSGR_E_LOGON_UI_ACTIVE   Val("0x81000315")
  Local lcResult, lcMessage
  If Vartype(lcException) = "O"
    lcResult = Val(Substr(lcException.Message, At("0x", lcException.Message ), 10))
    Do Case
      Case lcResult == MSGR_E_ALREADY_LOGGED_ON
            lcMessage = "El usuario actual ha ingresado." && "The current user is already signed in."
        Case lcResult == E_INVALIDARG
            lcMessage = "Falló la prueba de validación de los valroes ingresados." + Chr(13);
            + "El nombre o contraseña no pueden contener espacios" + Chr(13);
            + "retornos de carro, o avances de línea."
            && "Values provided failed validation tests. The sign-in name or password cannot contain spaces, carriage returns, or linefeed characters."
        Case lcResult == MSGR_E_NOT_LOGGED_ON
            lcMessage = "Debe estar registrado en el Messenger para realizar esta operación."
            && "You must be logged into Messenger to perform this operation."
        Case lcResult == MSGR_E_LOGON_UI_ACTIVE
            lcMessage = "No puede llamar al Autoingreso mientras el cuadro de diálogo" + Chr(13);
            + "ingresar cliente esté habilitado y visible." 
            && "You cannot call the AutoSignin method while the client Sign In dialog box is enabled and visible."
        Otherwise 
            lcMessage = lcException.Message
      Endcase
  Endif
  Messagebox(lcMessage, 48, "Enviar archivo")
Endproc
Pruébalo y me comentas...
Añade un comentario a esta respuesta
Añade tu respuesta
Haz clic para o
Escribe tu mensaje
¿No es la respuesta que estabas buscando? Puedes explorar otras preguntas del tema Visual Fox Pro o hacer tu propia pregunta: