José Luis Garcí,
Cita:
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
public
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.