Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Internet (https://www.clubdelphi.com/foros/forumdisplay.php?f=3)
-   -   Exportar a PDF y enviar documento por correo electrónico. Usando ppReport (https://www.clubdelphi.com/foros/showthread.php?t=78573)

xomen 30-04-2012 21:25:27

Exportar a PDF y enviar documento por correo electrónico. Usando ppReport
 
Buen día. Esta vez tratare de explicar una forma para generar y enviar por correo electrónico un documento en PDF. (claro puede ser en cualquier otro formato que el componente ofrezca pero ahora lo hice con PDF). espero y sea de ayuda.

En este primer paso vamos a guardar el documento en PDF.
Código Delphi [-]
procedure TFormCatalogo.SpeedButtonExportarClick(
  Sender: TObject);
var
  IDMaestro : integer;
  Ruta : string;
  saveDialog : TSaveDialog;
  ArchivoPDF : String;
begin
  try
    Screen.Cursor := crHourGlass;
    //Creamos un saveDialog   y le damos las características del documento.
    //En mi caso voy a recuperar el identificador de la consulta para cargar el ppReport
    IDMaestro := ADOQueryCatalogo.FieldByName('ID').AsInteger;
   //Recupero los datos a imprimir
    DatosParaImpresion(IDMaestro);
    saveDialog := TSaveDialog.Create(self);
    saveDialog.Title := 'Guardar Archivo';
    saveDialog.Filter := 'PDF|*.pdf';
    saveDialog.DefaultExt := 'pdf';
    saveDialog.FilterIndex := 1;
    if saveDialog.Execute then
    begin
      //Obtenemos la ruta, aquí desdi poner una variable publica tipo string ya que a usare en otro procedimiento
      FRuta := saveDialog.FileName;
      saveDialog.Free;
      //Ahora con el ppReport lo configuramos para guardarlo en pdf 
      ppReport.ShowPrintDialog := False;
      ppReport.DeviceType := 'PDF';
      ppReport.PDFSettings.Author := 'Autor';
      ppReport.TextFileName := FRuta;
    end;
    ppReport.Print;
    EnviaCorreoElectronico;
    Screen.Cursor := crDefault;
  except
    on E:Exception do
    begin
      Screen.Cursor := crDefault;
       raise Exception.Create('Error el exportar a formato PDF:'+#13+ E.Message);
    end;
  end;
end;

Ahora para enviar el correo electrónico se necesitan dos componentes en la pestaña indy Clients necesitamos el objeto IdSMTP y en la pestaña Indy Misc necesitamos el objeto IdMessage. ahora vamos a configurar.

Código Delphi [-]
procedure TFormCatalogo.EnviaCorreoElectronico;
var
   NombreUsuario : string;
   Correo   : string;
   Password : string;
   Host : string;
   Puerto : string;
   Autenticacion : TAuthenticationType;
   Firma : string;
   Destinatario : string;
   SMTP: TIdSMTP;
   Mensaje: TIdMessage;
   Adjunto: TIdAttachment;
   IDMaestro : integer;

begin
  //Recuperamos datos para el llenado de los requisitos del e-mail.
  //En este caso recupere mis datos de un catalogo anteriormente capturado.
  with ADOQueryRecuperaConfigMail do
  begin
    Close;
    Parameters.ParamByName('IDUsuario').Value :=  FUsuarioLink;
    Open;
    NombreUsuario :=
      FieldByName('NOMBREDELUSUARIO').AsString;
    Correo :=
      FieldByName('CORREO').AsString;
    Password :=
      FieldByName('CONTRASEÑA').AsString;
    Host :=
      FieldByName('HOST').AsString;
    Puerto :=
      FieldByName('PUERTO').AsString;
    if FieldByName('AUTENTICACION').AsString = '' then
      Autenticacion := atLogin
    else
      Autenticacion :=
        FieldByName('AUTENTICACION').AsVariant;
    Firma :=
      FieldByName('FIRMA').AsString;
  end;
  //El destinatario lo extraigo de mi catalogo según lo requiera se va a ir configurando dinamicamente.
  Destinatario :=
    ADOQueryReporte.FieldByName('EMAIL').AsString;
  if Destinatario = '' then
    raise Exception.Create('No existe correo electronico del destinatario.');
  //Creamos el componente de conexión con el servidor
  SMTP := TIdSMTP.Create( nil );
  SMTP.Username := Correo;
  SMTP.Password := Password;
  SMTP.Host := Host;
  SMTP.Port := StrToInt(Puerto);
  SMTP.AuthenticationType := Autenticacion;
  //Creamos el contenido del mensaje
  Mensaje := TIdMessage.Create( nil );
  Mensaje.Clear;
  Mensaje.From.Name := NombreUsuario;
  Mensaje.From.Address := Correo;
  Mensaje.Subject := 'Asunto';
  Mensaje.Body.Text := 'Cuerpo del mensaje '+#13+#13+Firma;
  Mensaje.Recipients.Add;
  Mensaje.Recipients.Items[0].Address := Destinatario;
  //Si hay que meter un archivo adjunto lo creamos y lo asignamos al mensaje
  if not ADOQueryReporteDetalle.IsEmpty then
  begin
    //Recuerdan la variable FRuta declarada en la seccion publica? aquí la utilizamos para saber de donde vamos a adjuntar.
    Adjunto := TIdAttachment.Create(Mensaje.MessageParts,FRuta);
  end
  else
    Adjunto := nil;
  //Le mostramos al usuario como quedara el correo electronico.
  if MessageDlg('El correo electrónico que se enviara es el siguiente:'+#13+#13+
    'Usuario: '+NombreUsuario+#13+
    'Correo: '+Correo+#13+#13+
    'Destinatario: '+Destinatario+#13+#13+
    'Ruta de Archivo Adjunto:'+FRuta+#13+#13+
    'Asunto: Asunto'+#13+
    'Body: '+#13+
    'Cuerpo del mensaje '+#13+#13+Firma,
    mtConfirmation, mbYesNoCancel, 0) = mrYes then
  begin
    // Si es afirmativa la respuesta entonces conectamos con el servidor SMTP
    try
      SMTP.Connect;
    except
      raise Exception.Create('Error al conectar con el servidor.');
    end;
    //Si ha conectado enviamos el mensaje y desconectamos
    if SMTP.Connected then
    begin
      try
        SMTP.Send( Mensaje );
      except
        raise Exception.Create('Error al enviar el mensaje.');
      end;
      try
        SMTP.Disconnect;
      except
        raise Exception.Create('Error al desconectar del servidor.');
      end;
    end;
    //Liberamos los objetos creados
    if Adjunto <> nil then
    FreeAndNil( Adjunto );
    FreeAndNil( Mensaje );
    FreeAndNil( SMTP );
    Application.MessageBox('Mensaje enviado correctamente.',
      ' ',MB_ICONINFORMATION );
  end;
end;

Bueno de mi parte es todo espero les sea de ayuda. Muchas gracias por leerme. Se aceptan criticas y mejoras al código. Muchas gracias

Casimiro Notevi 30-04-2012 22:54:26

Gracias por el aporte :)

xomen 30-04-2012 23:04:10

Cita:

Empezado por Casimiro Notevi (Mensaje 431453)
Gracias por el aporte :)

De nada amigo.

AzidRain 30-04-2012 23:21:11

Ya que andamos de ofrecidos, les dejo esta función con su explicación:
Código Delphi [-]
{Esta función analiza la extensión del archivo pasado como parámetro y nos
devuelte un MIMETYpe adecuado para enviar por mail como adjunto si la extension
no es reconocida se manda como genérico.
}
function GetMIMEType(afilename: string): String;
var Ext: string;
begin
  Ext := UpperCase(ExtractFileExt(afilename));

  if Ext='.PDF' then
   Result := 'application/pdf'
   else
     if Ext='.ZIP' then
       Result := 'application/zip'
     else
        if Ext='.MP3' then
         Result := 'audio/mpeg'
       else
       if (Ext='.JPG') OR (Ext='.JPEG') then
         Result := 'image/jpeg'
       else
         if (Ext='.XLS')  then
           Result := 'application/vnd.ms-excel'
         else
          if (Ext='.XLSX') then
            Result := 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet'
         else
           if (Ext='.DOC')  then
            Result := 'application/msword'
           else
           if (Ext='.DOCX')  then
            Result := 'application/vnd.openxmlformats-officedocument.wordprocessingml.document'
           else
            Result := 'application/octet-stream';


end;

En donde la usamos:

Código Delphi [-]
  With TIdAttachmentFile.Create(Mensaje.MessageParts,adjunto) do
                 ContentType := GetMIMEType(adjunto)

// Mensaje es un objeto de la case TIdMessage, adjunto es una variable que contiene el nombre del archivo con extensión que se desea enviar

Es recomendable fijar la propiedad ContentType debido a que algunos servicios de correo, sobre todo los de empresas, no reconocen las extensiones por defecto y en algunos casos sencillamente el mensaje aparecerá como si no trajera adjunto. Se pueden añadir mas tipos a la función que puse, los tipos los pueden obtener de aquí o bien aqui que también viene completo. Atención a que no hay que meter todos los tipos de manera forzada, solo los que consideren que su aplicación va a manejar.

xomen 30-04-2012 23:24:50

Cita:

Empezado por AzidRain (Mensaje 431456)
Ya que andamos de ofrecidos, les dejo esta función con su explicación:

Justo lo que necesitaba para mi siguiente proyecto muchas gracias AzidRain. Voy a jugar con ese código un rato después publico los resultados. Saludos.


La franja horaria es GMT +2. Ahora son las 06:53:11.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi