Mandar email con adjunto

[[nlsgarcia]]

José Luis Garcí,

Empezado por José Luis Garcí

...el cliente quiere emitir el documento y mandarlo por email...y preferiría hacerlo por código y no con un programa externo...

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Mapi;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function SendMailMAPI(const Subject, Body: String; Filenames: TStrings;
                      SenderName, SenderEMail, RecepientName, RecepientEMail: String): Integer;
type
   TAttachAccessArray = array [0..0] of TMapiFileDesc;
   PAttachAccessArray = ^TAttachAccessArray;

var
   MailMessage: TMapiMessage;
   lpSender, lpRecepient: TMapiRecipDesc;
   FileName: string;
   Attachments: PAttachAccessArray;
   SM: TFNMapiSendMail;
   MAPIModule: HModule;
   Counter: Byte;

   AuxStr : String;
   pAuxStr : Array[0..255] of AnsiChar;

   pSubject : Array[0..255] of AnsiChar;
   pBody : Array[0..9999] of AnsiChar;
   pSenderName : Array[0..255] of AnsiChar;
   pSenderEMail : Array[0..255] of AnsiChar;
   pRecepientName : Array[0..255] of AnsiChar;
   pRecepientEMail : Array[0..255] of AnsiChar;
   pFileName : Array[0..255] of AnsiChar;
   pFilePathName : Array[0..255] of AnsiChar;

begin

   StrPCopy(pSubject,Subject);
   StrPCopy(pBody,Body);
   StrPCopy(pSenderName,SenderName);
   StrPCopy(pSenderEMail,SenderEMail);
   StrPCopy(pRecepientName,RecepientName);
   StrPCopy(pRecepientEMail,RecepientEMail);

   FillChar(MailMessage, SizeOf(MailMessage), 0);

   with MailMessage do
   begin

      if (Subject <> '') then
         MailMessage.lpszSubject := @pSubject;

      if (Body <> '') then
         MailMessage.lpszNoteText := @pBody;

      if (SenderEMail <> '') then
      begin

         lpSender.ulRecipClass := MAPI_ORIG;

         if (SenderName = '') then
            lpSender.lpszName := @pSenderEMail
         else
            lpSender.lpszName := @pSenderName;

         AuxStr := 'SMTP:' + SenderEMail;
         StrPCopy(pAuxStr,AuxStr);

         lpSender.lpszAddress := @pAuxStr;
         lpSender.ulReserved := 0;
         lpSender.ulEIDSize := 0;
         lpSender.lpEntryID := nil;
         lpOriginator := @lpSender;

      end;

      if (RecepientEMail <> '') then
      begin
         lpRecepient.ulRecipClass := MAPI_TO;
         if (RecepientName = '') then
            lpRecepient.lpszName := @pRecepientEMail
         else
            lpRecepient.lpszName := @pRecepientName;

         AuxStr := 'SMTP:' + RecepientEMail;
         StrPCopy(pAuxStr,AuxStr);

         lpRecepient.lpszAddress := @pAuxStr;
         lpRecepient.ulReserved := 0;
         lpRecepient.ulEIDSize := 0;
         lpRecepient.lpEntryID := nil;
         nRecipCount := 1;
         lpRecips := @lpRecepient;
      end
      else
         lpRecips := nil;

      if Filenames.Count > 0 then
      begin

         nFileCount := Filenames.Count;

         GetMem(Attachments, SizeOf(TMapiFileDesc) * Filenames.Count);

         for Counter := 0 to Filenames.Count - 1 do
         begin
            FileName := Filenames[counter];
            Attachments[counter].ulReserved := 0;
            Attachments[counter].flFlags := 0;
            Attachments[counter].nPosition := ULONG($FFFFFFFF);

            StrPCopy(pFilePathName, Filename);
            Attachments[counter].lpszPathName := @pFilePathName;

            StrPCopy(pFileName, ExtractFileName(Filename));
            Attachments[counter].lpszFileName := @pFileName;

            Attachments[counter].lpFileType := nil;
         end;

         lpFiles := @Attachments^;

      end
      else
      begin
         nFileCount := 0;
         lpFiles := nil;
      end;

   end;

   MAPIModule := LoadLibrary(PChar(MAPIDLL));
   if MAPIModule = 0 then
      Result := -1
   else
   begin
      try
         @SM := GetProcAddress(MAPIModule, 'MAPISendMail');
         if @SM <> nil then
            Result := SM(0, Application.Handle, MailMessage, MAPI_DIALOG or MAPI_LOGON_UI, 0)
         else
            Result := 1
      finally
            FreeLibrary(MAPIModule);
      end;
   end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
   Subject, Body : String;
   MsgText : TStringList;
   Filenames : TStringList;
   SenderName, SenderEMail, RecepientName, RecepientEMail : String;
   i : Integer;

begin

   Subject := 'Prueba de Email con MAPI';

   MsgText := TStringList.Create;

   for i := 1 to 10 do
      MsgText.Add('Línea de Texto-' + IntToStr(i));

   Body := MsgText.Text;

   Filenames := TStringList.Create;
   Filenames.Add(IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile1.txt');
   Filenames.Add(IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile2.txt');

   SenderName := 'UserName Surname';
   SenderEMail := 'userName@gmail.com';

   RecepientName := 'AnotherUserName AnotherSurname';
   RecepientEMail := 'anotheruserName@gmail.com';

   SendMailMAPI(Subject, Body, Filenames, SenderName, SenderEMail, RecepientName, RecepientEMail);

   Filenames.Free;
   MsgText.Free;

end;

end.

El código anterior permite el envío de emails con sus adjuntos por medio del cliente por default de email a través de MAPI en Delphi 2010 bajo Windows 7 Professional x32 y x64, funcionado correctamente con los clientes de email FireBird y OutLook 2010.

La solución anterior depende de un programa externo (Cliente de email por default), pero es una solución intermedia (Parte código, Parte Programa Externo) que puede ser viable dependiendo de los requerimientos funcionales del proceso a automatizar.

Espero sea útil

Nelson.

[[nlsgarcia]]

José Luis Garcí,

(Continuación del Msg #21)

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Mapi;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function SendMailMAPI(Subject, MsgText: String;
                      Filenames: TStrings;
                      SenderName, SenderEMail, RecepientName, RecepientEMail: String): Integer;
type
   TAttachAccessArray = array [0..0] of TMapiFileDesc;
   PAttachAccessArray = ^TAttachAccessArray;

var
   MailMessage: TMapiMessage;
   lpSender, lpRecepient: TMapiRecipDesc;
   FileName: string;
   Attachments: PAttachAccessArray;
   SM: TFNMapiSendMail;
   MAPIModule: HModule;
   Counter: Byte;

   AuxStr : String;
   pAuxStr : Array[0..255] of AnsiChar;

   pSubject : Array[0..255] of AnsiChar;
   pMsgText : Array[0..9999] of AnsiChar;
   pSenderName : Array[0..255] of AnsiChar;
   pSenderEMail : Array[0..255] of AnsiChar;
   pRecepientName : Array[0..255] of AnsiChar;
   pRecepientEMail : Array[0..255] of AnsiChar;
   pFileName : Array[0..255] of AnsiChar;
   pPathName : Array[0..255] of AnsiChar;

begin

   StrPCopy(pSubject,Subject);
   StrPCopy(pMsgText,MsgText);
   StrPCopy(pSenderName,SenderName);
   StrPCopy(pSenderEMail,SenderEMail);
   StrPCopy(pRecepientName,RecepientName);
   StrPCopy(pRecepientEMail,RecepientEMail);

   FillChar(MailMessage, SizeOf(MailMessage), 0);

   with MailMessage do
   begin

      if (Subject <> '') then
         MailMessage.lpszSubject := @pSubject;

      if (MsgText <> '') then
         MailMessage.lpszNoteText := @pMsgText;

      if (SenderEMail <> '') then
      begin

         lpSender.ulRecipClass := MAPI_ORIG;

         if (SenderName = '') then
            lpSender.lpszName := @pSenderEMail
         else
            lpSender.lpszName := @pSenderName;

         AuxStr := 'SMTP:' + SenderEMail;
         StrPCopy(pAuxStr,AuxStr);

         lpSender.lpszAddress := @pAuxStr;
         lpSender.ulReserved := 0;
         lpSender.ulEIDSize := 0;
         lpSender.lpEntryID := nil;
         lpOriginator := @lpSender;

      end;

      if (RecepientEMail <> '') then
      begin
         lpRecepient.ulRecipClass := MAPI_TO;
         if (RecepientName = '') then
            lpRecepient.lpszName := @pRecepientEMail
         else
            lpRecepient.lpszName := @pRecepientName;

         AuxStr := 'SMTP:' + RecepientEMail;
         StrPCopy(pAuxStr,AuxStr);

         lpRecepient.lpszAddress := @pAuxStr;
         lpRecepient.ulReserved := 0;
         lpRecepient.ulEIDSize := 0;
         lpRecepient.lpEntryID := nil;
         nRecipCount := 1;
         lpRecips := @lpRecepient;
      end
      else
         lpRecips := nil;

      if Filenames.Count > 0 then
      begin

         nFileCount := Filenames.Count;

         GetMem(Attachments, SizeOf(TMapiFileDesc) * Filenames.Count);

         for Counter := 0 to Filenames.Count - 1 do
         begin
            FileName := Filenames[counter];
            Attachments[counter].ulReserved := 0;
            Attachments[counter].flFlags := 0;
            Attachments[counter].nPosition := ULONG($FFFFFFFF);

            StrPCopy(pPathName, Filename);
            Attachments[counter].lpszPathName := StrNew(pPathName);

            StrPCopy(pFileName, ExtractFileName(Filename));
            Attachments[counter].lpszFileName := StrNew(pFileName);

            Attachments[counter].lpFileType := nil;
         end;

         lpFiles := @Attachments^;

      end
      else
      begin
         nFileCount := 0;
         lpFiles := nil;
      end;

   end;

   MAPIModule := LoadLibrary(PChar(MAPIDLL));
   if MAPIModule = 0 then
      Result := -1
   else
   begin
      try
         @SM := GetProcAddress(MAPIModule, 'MAPISendMail');
         if @SM <> nil then
            Result := SM(0, Application.Handle, MailMessage, MAPI_DIALOG or MAPI_LOGON_UI, 0)
         else
            Result := 1
      finally
            FreeLibrary(MAPIModule);
      end;
   end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
   Subject : String;
   MsgText : TStringList;
   FileName : String;
   Filenames : TStringList;
   SenderName, SenderEMail, RecepientName, RecepientEMail : String;
   i : Integer;

begin

   Subject := 'Prueba de Email con MAPI';

   MsgText := TStringList.Create;

   for i := 1 to 10 do
      MsgText.Add('Línea de Texto-' + IntToStr(i));

   Filenames := TStringList.Create;

   FileName := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile1.txt';
   if FileExists(FileName) then
      Filenames.Add(FileName);

   FileName := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile2.txt';
   if FileExists(FileName) then
      Filenames.Add(FileName);

   FileName := IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) + 'TestFile3.txt';
   if FileExists(FileName) then
      Filenames.Add(FileName);

   SenderName := 'UserName Surname';
   SenderEMail := 'userName@gmail.com';

   RecepientName := 'AnotherUserName AnotherSurname';
   RecepientEMail := 'anotheruserName@gmail.com';

   SendMailMAPI(Subject, MsgText.Text, Filenames,
                SenderName, SenderEMail, RecepientName, RecepientEMail);

   Filenames.Free;
   MsgText.Free;

end;

end.

El código anterior es la Versión 2 del código del Msg #21 la cual incluye una corrección y una mejora en el proceso de Attachment de archivos vía MAPI, ambas necesarias para el buen funcionamiento de la aplicación.

Espero sea útil

Nelson.

[[José Luis Garcí]]

Gracias Nelson, esta semana los mirare, pero no se cuando, ya que el jefe, me ha pedido una serie de cosas con urgencia, además tengo que terminar de preparar otras cosas antes de volver a la península, pero en cuanto lo pruebe te comento.

Repito, muchas gracias por tu ayuda.

[[José Luis Garcí]]

Hola Nelson, me funciono bastante bien, he probado con las dos configuraciones, las dos funcionaron, pero es cierto que la segunda, si me manda archivos diferentes mientras que la primera se limitaba a mandarme dos veces el último archivo.

Pero no todo fue un camino de rosas, para llegar a ello, tuve que usar el Outlock, que nunca me he molestado en configurar y gracias al siguiente enlace http://office.microsoft.com/es-es/ou...001148898.aspx he podido solucionar el tema, te estoy muy agradecido sinceramente.

[[nlsgarcia]]

José Luis Garcí,

Empezado por José Luis Garcí

...me funciono bastante bien... (Código del Msg #22)

Te sugiero:

1- Si puedes instalar el cliente de correo Thunderbird te lo recomiendo ampliamente, es fácil de instalar, liviano, versátil, free y muy potente.

2- Revisa el código de los Msg #9 y #15, te serán útiles en desarrollos bajo Win32.

3- El código del Msg #9 se puede adaptar para que funcione bajo Win64.

4- El código del Msg #22 te sera útil en desarrollos bajo Win32 y Win64.

Espero sea útil

Nelson.

[[José Luis Garcí]]

Si que me ha sido útil, gracias nuevamente Nelson

[AzqLaaClub]

Mailfrom:Permanent Failure-Other or undefined security status.
como lo puedo arreglar?
uso windows 10, y delphi 10 Embarcadero RAD Studio

[Casimiro Notevi]

Empezado por AzqLaaClub

Mailfrom:Permanent Failure-Other or undefined security status.
como lo puedo arreglar?
uso windows 10, y delphi 10 Embarcadero RAD Studio

Hola, por favor, crea un hilo nuevo con tu duda, gracias.
Y no olvides echar un vistazo a nuestra guía de estilo. Saludos.

[AzqLaaClub]

Buenos dias!
Saludos soy de Cuba.
Ciertamente he probado el 99.9% de los ejemplos posteados aqui para enviar email y ninguno me funcioina, siempre me dan errores diferentes

Uso: Windows 10 64 bits.
Delphi 10 Embarcadero RAD Studio.
conexion a internet lenta pero me funciona.

Este es mi problema: Estoy trabajando en un software q me permita enviar email como notificacion, pero no encuentro
un ejemplo q me permita enviar email usando gmail, todos me dan un error diferente:
Connetion closed grace fully
usando el ejemplo de NLSGarcias q usa la libreria Synapse, despues corregir algunos errores me da el siguiente: Permanent Failure-Othres or Undefined security status.

Por favor si alguien puede Ayudarme con algo funcional, GRacias. Me URGEEEEE.

[Casimiro Notevi]

Empezado por AzqLaaClub

Buenos dias!

Y no olvides echar un vistazo a nuestra guía de estilo. Saludos.

[[José Luis Garcí]]

Empezado por AzqLaaClub

Buenos dias!
Saludos soy de Cuba.
Ciertamente he probado el 99.9% de los ejemplos posteados aqui para enviar email y ninguno me funcioina, siempre me dan errores diferentes

Uso: Windows 10 64 bits.
Delphi 10 Embarcadero RAD Studio.
conexion a internet lenta pero me funciona.

Este es mi problema: Estoy trabajando en un software q me permita enviar email como notificacion, pero no encuentro
un ejemplo q me permita enviar email usando gmail, todos me dan un error diferente:
Connetion closed grace fully
usando el ejemplo de NLSGarcias q usa la libreria Synapse, despues corregir algunos errores me da el siguiente: Permanent Failure-Othres or Undefined security status.

Por favor si alguien puede Ayudarme con algo funcional, GRacias. Me URGEEEEE.

Recuerda que para mandar emails por Gmail, debes quitarle opciones de seguridad en el gmail, por lo que no te lo recomiendo, mejor usa thunderbird de intermediario entre delphi y el gmail, es por lo que he optado yo. Sólo mando mensajes directos a mi gmail, de errores de forma oculta, cuando en una aplicación de la asociación se ha cometido un error