Sending e-mail with attachment using MS Outlook

Problem/Question/Abstract:

How to send e-mail with attachment using MS outlook

Answer:

Solve 1:

The unit that can do the job is scratched below:

unit OutLookMail;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Outlook8, OleServer, COMobj, ActiveX;

type
  TMailRecord = record
    FileToAttach: string;
    MailTo: string;
    CC: string;
    BCC: string;
    Subject: string;
    Body: string;
  end;

procedure OutLookMailProc(MailDetail: TMailRecord);

implementation

procedure OutLookMailProc(MailDetail: TMailRecord);
var
  objOutlook: OutlookApplication;
  CurrentInterface: IUnknown;
  ActiveApplication: HResult;
  CurrentMailItem: MailItem;
  MailInspector: Inspector;
begin
  ActiveApplication := GetActiveObject(CLASS_OutlookApplication, nil,
    CurrentInterface);
  if ActiveApplication = MK_E_UNAVAILABLE then
    objOutlook := CoOutlookApplication.Create
  else
  begin
    OleCheck(ActiveApplication);
    OleCheck(CurrentInterface.QueryInterface(OutlookApplication, objOutlook));
  end;
  CurrentMailItem := objOutlook.CreateItem(0) as MailItem;
  CurrentMailItem.To_ := MailDetail.MailTo;
  if MailDetail.FileToAttach <> '' then
    CurrentMailItem.Attachments.Add(MailDetail.FileToAttach, EmptyParam, EmptyParam,
      EmptyParam);
  CurrentMailItem.cc := MailDetail.CC;
  CurrentMailItem.BCC := MailDetail.BCC;
  CurrentMailItem.Subject := MailDetail.Subject;
  CurrentMailItem.Body := MailDetail.Body;
  MailInspector := CurrentMailItem.GetInspector;
  MailInspector.Display(False);
  Showmessage('I am waiting you to finish the mail process. Please click OK when done !');
  objOutlook.Quit;
  objOutlook := nil;
end;

end.

Unit for the Demo:

unit MailDemo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Db, qrprntr, Qrctrls, qrExtra, qrexport, DBTables, QuickRpt, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    EditMailTo: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    EditSubject: TEdit;
    Label3: TLabel;
    EditFileToAttach: TEdit;
    Memo1: TMemo;
    Label4: TLabel;
    Label5: TLabel;
    EditCC: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses OutLookMail;

{$R *.DFM}

const
  CRLF = chr(13) + chr(10);

procedure TForm1.Button1Click(Sender: TObject);
var
  MailDetail: TMailRecord;
  x: integer;
begin
  MailDetail.FileToAttach := EditFileToAttach.Text;
  MailDetail.MailTo := EditMailTo.Text;
  MailDetail.CC := EditCC.Text;
  MailDetail.subject := EditSubject.Text;
  MailDetail.Body := '';
  for x := 0 to Memo1.Lines.Count - 1 do
    MailDetail.Body := MailDetail.Body + Memo1.lines[x] + CRLF;
  OutLookMailProc(MailDetail);
end;

end.


Component Download: MailDemo.zip


Solve 2:

procedure SendMail;
var
  OleApp, OleItem: OleVariant;
begin
  try
    try
      OleApp := GetActiveOleObject('Outlook.Application');
    except
      OleApp := CreateOleObject('Outlook.Application');
    end;

    OleItem := OleApp.CreateItem(0);
    OleItem.Subject := 'Add Subject Here';
    OleItem.Recipients.Add('Recipients Here');
    OleItem.Attachments.Add('File Attachments Here');
    OleItem.Body := 'EMail body text here';
    OleItem.CC := 'Semi Colon delimited CC here';
    OleItem.BCC := 'Semi Colon delimted BCC here';
    OleItem.Send;
    OleItem := VarNull;
    OleApp := VarNull;
  except
    OleItem := VarNull;
    OleApp := VarNull;
    ShowMessage('EMail failed');
  end;
end;