Author: Raghunath Dhungel
How to send e-mail with attachment using MS outlook
Answer:
Solve 1:
The unit that can do the job is scratched below:
1 unit OutLookMail;
2
3 interface
4 uses
5 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
6 Outlook8, OleServer, COMobj, ActiveX;
7
8 type
9 TMailRecord = record
10 FileToAttach: string;
11 MailTo: string;
12 CC: string;
13 BCC: string;
14 Subject: string;
15 Body: string;
16 end;
17
18 procedure OutLookMailProc(MailDetail: TMailRecord);
19
20 implementation
21
22 procedure OutLookMailProc(MailDetail: TMailRecord);
23 var
24 objOutlook: OutlookApplication;
25 CurrentInterface: IUnknown;
26 ActiveApplication: HResult;
27 CurrentMailItem: MailItem;
28 MailInspector: Inspector;
29 begin
30 ActiveApplication := GetActiveObject(CLASS_OutlookApplication, nil,
31 CurrentInterface);
32 if ActiveApplication = MK_E_UNAVAILABLE then
33 objOutlook := CoOutlookApplication.Create
34 else
35 begin
36 OleCheck(ActiveApplication);
37 OleCheck(CurrentInterface.QueryInterface(OutlookApplication, objOutlook));
38 end;
39 CurrentMailItem := objOutlook.CreateItem(0) as MailItem;
40 CurrentMailItem.To_ := MailDetail.MailTo;
41 if MailDetail.FileToAttach <> '' then
42 CurrentMailItem.Attachments.Add(MailDetail.FileToAttach, EmptyParam, EmptyParam,
43 EmptyParam);
44 CurrentMailItem.cc := MailDetail.CC;
45 CurrentMailItem.BCC := MailDetail.BCC;
46 CurrentMailItem.Subject := MailDetail.Subject;
47 CurrentMailItem.Body := MailDetail.Body;
48 MailInspector := CurrentMailItem.GetInspector;
49 MailInspector.Display(False);
50 Showmessage('I am waiting you to finish the mail process. Please click OK when
51 done !'
52 objOutlook.Quit;
53 objOutlook := nil;
54 end;
55
56 end.
57
58 //Unit for the Demo:
59
60 unit MailDemo;
61
62 interface
63
64 uses
65 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
66 StdCtrls, Db, qrprntr, Qrctrls, qrExtra, qrexport, DBTables, QuickRpt, ExtCtrls;
67
68 type
69 TForm1 = class(TForm)
70 Button1: TButton;
71 EditMailTo: TEdit;
72 Label1: TLabel;
73 Label2: TLabel;
74 EditSubject: TEdit;
75 Label3: TLabel;
76 EditFileToAttach: TEdit;
77 Memo1: TMemo;
78 Label4: TLabel;
79 Label5: TLabel;
80 EditCC: TEdit;
81 procedure Button1Click(Sender: TObject);
82 private
83 { Private declarations }
84 public
85 { Public declarations }
86 end;
87
88 var
89 Form1: TForm1;
90
91 implementation
92
93 uses OutLookMail;
94
95 {$R *.DFM}
96
97 const
98 CRLF = chr(13) + chr(10);
99
100 procedure TForm1.Button1Click(Sender: TObject);
101 var
102 MailDetail: TMailRecord;
103 x: integer;
104 begin
105 MailDetail.FileToAttach := EditFileToAttach.Text;
106 MailDetail.MailTo := EditMailTo.Text;
107 MailDetail.CC := EditCC.Text;
108 MailDetail.subject := EditSubject.Text;
109 MailDetail.Body := '';
110 for x := 0 to Memo1.Lines.Count - 1 do
111 MailDetail.Body := MailDetail.Body + Memo1.lines[x] + CRLF;
112 OutLookMailProc(MailDetail);
113 end;
114
115 end.
Component Download:
MailDemo.ziphttp://www.delphi3000.com/redirect.asp?Link=../article/2626/MailDemo.zip
Solve 2:
116 procedure SendMail;
117 var
118 OleApp, OleItem: OleVariant;
119 begin
120 try
121 try
122 OleApp := GetActiveOleObject('Outlook.Application');
123 except
124 OleApp := CreateOleObject('Outlook.Application');
125 end;
126
127 OleItem := OleApp.CreateItem(0);
128 OleItem.Subject := 'Add Subject Here';
129 OleItem.Recipients.Add('Recipients Here');
130 OleItem.Attachments.Add('File Attachments Here');
131 OleItem.Body := 'EMail body text here';
132 OleItem.CC := 'Semi Colon delimited CC here';
133 OleItem.BCC := 'Semi Colon delimted BCC here';
134 OleItem.Send;
135 OleItem := VarNull;
136 OleApp := VarNull;
137 except
138 OleItem := VarNull;
139 OleApp := VarNull;
140 ShowMessage('EMail failed');
141 end;
142 end;
|
