您的位置：首页 > 编程语言 > Delphi

delphi调用OUTLOOK发送DBGRID中的数据（注意不是OUTLOOK EXPRESS ），带显示发送邮件界面。

2007-01-18 01:21 661 查看

{在网上搜了很久，发现DELPHI7.0调用OUTLOOK都没有提如何显示发送邮件界面，后来发现WINDOWS自带的VBAOUTL9.CHM 里面有详细的说明。

示范代码：

}

unit SendMailForm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, StdCtrls, Menus,OriFormat, DB, ADODB, jpeg,printers,Mapi,Math,
OleServer, Excel2000,clipbrd,StrUtils, Grids, DBGrids,ComObj, ActiveX,
NavatorPanel, MapiControl;

type
TSendMailForm= class(TForm)

button1:Tbutton;
DataSource1: TDataSource;
DBGrid1: Tdbgrid;
Adoquery1:Tadoquery;
procedure button1onclick(sender:Tobject);
private
{ Private declarations }

public
{ Public declarations }

procedure exportdbgridtoemail(dbgrid: Tdbgrid);

end;

var
SendMailForm: TSendMailForm;

implementation

{$R *.dfm}

procedure TSendMailForm.exportdbgridtoemail(dbgrid: Tdbgrid);
var
Outlook, NmSpace, Folder: OleVariant;
miMail: Variant;
s:string;

MapiControl1:TMapiControl;

const
olMailItem = 0;

function dbgridtohtmls(dbgrid:tdbgrid):string;
var s:string;
i:integer;
begin

s:='<html><body>'; //
s:=s+'<hr>' ;
s:=s+'<table /border="1" bordercolor="#000080">'; //
with dbgrid.DataSource.DataSet do
begin
DisableControls;
first;

s:=s+'<tr align="left">';//

for i:=0 to dbgrid.FieldCount-1 do
if dbgrid.findcolumn(dbgrid.Fields[i].FieldName).Visible then
if ((dbgrid.DataSource.DataSet.Fields[i].DataType<>ftGuid) and (dbgrid.DataSource.DataSet.Fields[i].DataType<>ftBlob)) then
s:=s+'<td>'+dbgrid.DataSource.DataSet.Fields[i].DisplayLabel+'</td>';
// nowrap
s:=s+'</tr>' ;

while not eof do
begin
s:=s+''+'<tr align="left">';////<br>
for i:=0 to dbgrid.FieldCount-1 do
begin
if dbgrid.findcolumn(dbgrid.Fields[i].FieldName).Visible then
if ((dbgrid.DataSource.DataSet.Fields[i].DataType<>ftGuid) and (dbgrid.DataSource.DataSet.Fields[i].DataType<>ftBlob)) then
begin
if dbgrid.DataSource.DataSet.Fields[i].IsNull then
s:=s+'<td nowrap> </td>'
else
if dbgrid.DataSource.DataSet.Fields[i].AsString='' then
s:=s+'<td nowrap> </td>'
else
s:=s+'<td nowrap>'+dbgrid.DataSource.DataSet.Fields[i].asstring+'</td>';
end;
end;

//exit;
s:=s+'</tr>';
next;
end;

//s:=s+'<tr><td>'+BottomMemo+'</td></tr>';
EnableControls;
end;

//s:=s+'<tr>xx</tr>';
s:=s+'</table>';
s:=s+'</body></html>';
//

result:=s;
end;

begin
inherited;

//showmessage('begin to create');
try
Outlook := CreateOleObject('Outlook.Application');
except
on e:exception do
begin
alert('请检查您电脑上是否安装了Outlook:'+e.Message);
exit;
end;
end;

//showmessage('create ok');

miMail := Outlook.CreateItem(olMailItem);
//miMail.Recipients.Add(INPUTBOX('请输入邮箱地址！','',''));
miMail.Subject := ((self as tform).caption) ;

// use this to send a plain text email (all versions of Outlook)
//miMail.Body := 'Attached is the list of email addresses.';

// alternatively send an HTML email (not in Outlook 97)
//showmessage('make html');
miMail.HTMLBody :=dbgridtohtmls(dbgrid);
//showmessage('html maked');
//'<font color=red>Attached is the <b>list of email</b> addresses.</font>';

//miMail.Attachments.Add('C:/temp/list.txt', EmptyParam, EmptyParam, EmptyParam);
//miMail.Send;
//显示发送邮件的界面。
miMail.Display;

//showmessage('发送完毕！');

end;

procedure TSendMailForm.Button1Click(Sender: TObject);
begin
exportdbgridtoemail(dbgrid1)
end;

end.

//希望对大家有所帮助

内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理

标签：

相关文章推荐

新的分享

章节导航