Sending e-mail with attachment using MS Outlook (Views: 712)
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; |