用传统的TQuery查询数据,然后把查询结果保存到Excel中(采用Delphi自带的Excel接口控件)
感觉速度非常慢,仅条记录就需要大概半分钟的时间以下为我用的代码var
ExcelApp: TExcelApplication;
ExcelBook: TExcelWorkbook;
ExcelSheet: TExcelWorksheet;
Qu: TQuery;procedure TFmHis.BtnSaveClick(Sender: TObject); //保存查询结果
var
i,j:integer;
begin
if ((not Qu.Active) or (Qu.RecordCount=0)) then
begin
MessageBox(Application.Handle,'请先查询历史数据!!!','注意',MB_OK);
exit;
end; try
ExcelApp.Connect;
except
MessageBox(Application.Handle,'请先安装Excel!!!','注意',MB_OK);
exit;
end; ExcelApp.Visible[0]:=true;
ExcelBook.ConnectTo(ExcelApp.Workbooks.Add(TOleEnum(xlWBATWorksheet), 0)); ExcelSheet.ConnectTo(ExcelBook.Worksheets[1] as _Worksheet);
ExcelSheet.Name := '历史数据'+FormatDateTime('yyyymmdd',Now);
ExcelSheet.Activate; ExcelSheet.Range['E1', 'E1'].Value := '历史数据查询结果表';
with ExcelSheet.Range['E1', 'E1'].Font do
begin
Size := 26;
Name := '隶书';
FontStyle := 'Bold';
end; for j := 0 to Qu.FieldCount-1 do
ExcelSheet.Cells.Item[3,j+1] := Qu.Fields[j].FieldName;
ExcelSheet.Range['A3', Chr(Ord('A')+Qu.FieldCount-1)+'3'].Font.FontStyle := 'Bold'; ExcelSheet.Range['A4', Chr(Ord('A')+Qu.FieldCount-1)+IntToStr(Qu.RecordCount+3)].EntireColumn.NumberFormat := '@';
i := 4;
with Qu do
begin
First;
while not Eof do
begin
for j := 0 to Qu.FieldCount-1 do
ExcelSheet.Cells.Item[i,j+1] := Qu.Fields[j].AsVariant;
Next;
Inc(i);
end;
First;
end; try
ExcelApp.Quit;
ExcelSheet.Disconnect;
ExcelBook.Disconnect;
ExcelApp.Disconnect;
except
end;
end;
感觉速度非常慢,仅条记录就需要大概半分钟的时间以下为我用的代码var
ExcelApp: TExcelApplication;
ExcelBook: TExcelWorkbook;
ExcelSheet: TExcelWorksheet;
Qu: TQuery;procedure TFmHis.BtnSaveClick(Sender: TObject); //保存查询结果
var
i,j:integer;
begin
if ((not Qu.Active) or (Qu.RecordCount=0)) then
begin
MessageBox(Application.Handle,'请先查询历史数据!!!','注意',MB_OK);
exit;
end; try
ExcelApp.Connect;
except
MessageBox(Application.Handle,'请先安装Excel!!!','注意',MB_OK);
exit;
end; ExcelApp.Visible[0]:=true;
ExcelBook.ConnectTo(ExcelApp.Workbooks.Add(TOleEnum(xlWBATWorksheet), 0)); ExcelSheet.ConnectTo(ExcelBook.Worksheets[1] as _Worksheet);
ExcelSheet.Name := '历史数据'+FormatDateTime('yyyymmdd',Now);
ExcelSheet.Activate; ExcelSheet.Range['E1', 'E1'].Value := '历史数据查询结果表';
with ExcelSheet.Range['E1', 'E1'].Font do
begin
Size := 26;
Name := '隶书';
FontStyle := 'Bold';
end; for j := 0 to Qu.FieldCount-1 do
ExcelSheet.Cells.Item[3,j+1] := Qu.Fields[j].FieldName;
ExcelSheet.Range['A3', Chr(Ord('A')+Qu.FieldCount-1)+'3'].Font.FontStyle := 'Bold'; ExcelSheet.Range['A4', Chr(Ord('A')+Qu.FieldCount-1)+IntToStr(Qu.RecordCount+3)].EntireColumn.NumberFormat := '@';
i := 4;
with Qu do
begin
First;
while not Eof do
begin
for j := 0 to Qu.FieldCount-1 do
ExcelSheet.Cells.Item[i,j+1] := Qu.Fields[j].AsVariant;
Next;
Inc(i);
end;
First;
end; try
ExcelApp.Quit;
ExcelSheet.Disconnect;
ExcelBook.Disconnect;
ExcelApp.Disconnect;
except
end;
end;
推荐:XLSReadWriteII 和dvexport 两款,很好用的,里面带帮助文件,
直接将一个DataSet导出到一个外部的Excel文件中,无需安装OFFICE 也行的。
只要指定几个属性,然后调用Write方法就OK。
http://www.delphifans.com/ 上有的下。。
procedure CopyDbDataToExcel(Target: TDbgrid);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
//通过ole创建Excel对象
try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end;
XLApp.WorkBooks.Add['e:\1.xls']; //你要把数据放在那里啊,先生成个文件在e:\1.xls
XLApp.WorkBooks[1].WorkSheets[1].Name := '测试工作薄';
Sheet := XLApp.Workbooks[1].WorkSheets['测试工作薄'];
if not Target.DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
Target.DataSource.DataSet.first;for iCount := 0 to Target.Columns.Count - 1 do
begin
Sheet.cells[1, iCount + 1] := Target.Columns.Items[iCount].Title.Caption;
end;
jCount := 1;
while not Target.DataSource.DataSet.Eof do
begin
for iCount := 0 to Target.Columns.Count - 1 do
begin
Sheet.cells[jCount + 1, iCount + 1] := Target.Columns.Items[iCount].Field.AsString;
end;
Inc(jCount);
Target.DataSource.DataSet.Next;
end;
XlApp.Visible := True;
Screen.Cursor := crDefault;
end;
速度不是很慢,可以接受~
如果用SQL语句的话会好的多
然后再根据具体情况进行EXCEL的格式的编辑
这样就快多了
EXEC master..xp_cmdshell 'bcp DB.dbo.tablename out c:\a.xls -c -q -S"GNETDATA/GNETDATA" -U"sa" -P""'
还有一个邹老大写的存储过程,这样你可以把SQL语句直接改改就行了
/*--数据导出EXCEL
导出查询中的数据到Excel,包含字段名,文件为真正的Excel文件
,如果文件不存在,将自动创建文件
,如果表不存在,将自动创建表
基于通用性考虑,仅支持导出标准数据类型
--邹建 2003.10--*//*--调用示例 p_exporttb @sqlstr='select * from 地区资料'
,@path='c:\',@fname='aa.xls',@sheetname='地区资料'
--*/
if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[p_exporttb]') and OBJECTPROPERTY(id, N'IsProcedure') = 1)
drop procedure [dbo].[p_exporttb]
GOcreate proc p_exporttb
@sqlstr sysname, --查询语句,如果查询语句中使用了order by ,请加上top 100 percent
@path nvarchar(1000), --文件存放目录
@fname nvarchar(250), --文件名
@sheetname varchar(250)='' --要创建的工作表名,默认为文件名
as
declare @err int,@src nvarchar(255),@desc nvarchar(255),@out int
declare @obj int,@constr nvarchar(1000),@sql varchar(8000),@fdlist varchar(8000)--参数检测
if isnull(@fname,'')='' set @fname='temp.xls'
if isnull(@sheetname,'')='' set @sheetname=replace(@fname,'.','#')--检查文件是否已经存在
if right(@path,1)<>'\' set @path=@path+'\'
create table #tb(a bit,b bit,c bit)
set @sql=@path+@fname
insert into #tb exec master..xp_fileexist @sql--数据库创建语句
set @sql=@path+@fname
if exists(select 1 from #tb where a=1)
set @constr='DRIVER={Microsoft Excel Driver (*.xls)};DSN='''';READONLY=FALSE'
+';CREATE_DB="'+@sql+'";DBQ='+@sql
else
set @constr='Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties="Excel 5.0;HDR=YES'
+';DATABASE='+@sql+'"'--连接数据库
exec @err=sp_oacreate 'adodb.connection',@obj out
if @err<>0 goto lberrexec @err=sp_oamethod @obj,'open',null,@constr
if @err<>0 goto lberr--创建表的SQL
declare @tbname sysname
set @tbname='##tmp_'+convert(varchar(38),newid())
set @sql='select * into ['+@tbname+'] from('+@sqlstr+') a'
exec(@sql)select @sql='',@fdlist=''
select @fdlist=@fdlist+','+a.name
,@sql=@sql+',['+a.name+'] '
+case when b.name in('char','nchar','varchar','nvarchar') then
'text('+cast(case when a.length>255 then 255 else a.length end as varchar)+')'
when b.name in('tynyint','int','bigint','tinyint') then 'int'
when b.name in('smalldatetime','datetime') then 'datetime'
when b.name in('money','smallmoney') then 'money'
else b.name end
FROM tempdb..syscolumns a left join tempdb..systypes b on a.xtype=b.xusertype
where b.name not in('image','text','uniqueidentifier','sql_variant','ntext','varbinary','binary','timestamp')
and a.id=(select id from tempdb..sysobjects where name=@tbname)
select @sql='create table ['+@sheetname
+']('+substring(@sql,2,8000)+')'
,@fdlist=substring(@fdlist,2,8000)exec @err=sp_oamethod @obj,'execute',@out out,@sql
if @err<>0 goto lberrexec @err=sp_oadestroy @obj--导入数据
set @sql='openrowset(''MICROSOFT.JET.OLEDB.4.0'',''Excel 5.0;HDR=YES
;DATABASE='+@path+@fname+''',['+@sheetname+'$])'exec('insert into '+@sql+'('+@fdlist+') select '+@fdlist+' from ['+@tbname+']')set @sql='drop table ['+@tbname+']'
exec(@sql)
returnlberr:
exec sp_oageterrorinfo 0,@src out,@desc out
lbexit:
select cast(@err as varbinary(4)) as 错误号
,@src as 错误源,@desc as 错误描述
select @sql,@constr,@fdlist
EXEC master..xp_cmdshell 'bcp groupdata.dbo.projectsuma out "c:\10.xls" /c /U"sa" -P"sa"'
procedure TCustomCommonRoutine.SaveToExcel(FDataSet: array of TDataSet;
Title, SubTitle, FileName: string);
var
i, j: Integer;
sList: TStringList;
begin
sList := TStringList.Create;
sList.Clear;
if length(FDataSet) > 0 then
begin
sList.Add('<HTML>');
sList.Add(#9 + '<HEAD>');
sList.Add(#9 +
'<meta http-equiv="content-type" content="text/html; charset=gb2312">');
sList.Add(#9#9 + '<H2 align="center">');
sList.Add(Title);
sList.Add(#9#9 + '</H2>');
sList.Add(#9#9 + '<H3 align="center">');
sList.Add(SubTitle);
sList.Add(#9#9 + '</H3>');
sList.Add(#9 + '</HEAD>');
sList.Add('<body>');
sList.Add('<table width="100%" border="1">');
for i := 0 to length(FDataSet) - 1 do
begin
with FDataSet[i] do
begin
sList.Add(#9 + '<tr>');
for j := 0 to FDataSet[i].FieldCount - 1 do
begin
if FDataSet[i].Fields[j].Visible = true then
begin
sList.Add(#9#9 + '<td>');
sList.Add(#9#9 + FDataSet[i].Fields[j].DisplayName);
sList.Add(#9#9 + '</td>');
end;
end;
sList.Add(#9 + '</tr>');
if FDataSet[i].RecordCount > 0 then
begin
FDataSet[i].First;
while not FDataSet[i].Eof do
begin
sList.Add(#9 + '<tr>');
for j := 0 to FDataSet[i].FieldCount - 1 do
begin
if fDataSet[i].Fields[j].Visible = true then
begin
sList.Add(#9#9 + '<td>');
sList.Add(#9#9 + trim(FDataSet[i].Fields[j].AsString));
sList.Add(#9#9 + '</td>');
end;
end;
sList.Add(#9 + '</tr>');
FDataSet[i].next;
end;
end
else
begin
sList.Add(#9 + '<tr>');
for j := 0 to FDataSet[i].FieldCount - 1 do
begin
if fDataSet[i].Fields[j].Visible = true then
begin
sList.Add(#9#9 + '<td>');
sList.Add(#9#9 + '');
sList.Add(#9#9 + '</td>');
end;
end;
sList.Add(#9 + '</tr>');
end;
end;
end;
sList.Add('</table>');
sList.Add('</body>');
sList.SaveToFile(FileName+'.xls');
end;
sList.Free;
end;