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.