Delphi编程将数据库数据快速导入Excel

在开发数据库应用程序中，经常要将类型相同的数据导出来，放到excel文件中，利用excel强大的编辑功能，对数据作进一步的加工处理。这有许多的方法，我们可以使用ole技术，在delphi中创建一个自动化对象，通过该对象来传送数据。也可以使用ado，通过与excel数据存储建立连接，使用ado这种独立于数据库后端的技术来导出数据集的数据。 

　　可这两种技术都有一个共同的缺点，那就是慢，数据量少还好，用户不会有太多的感觉，可一旦数据量大，比如，超过1千条，速度就让人难以忍受了，那么有没有更好的办法，既可以快速地导出数据，又不用安装附加的软件。也许好多人都想到了剪贴板的方式，这种方式速度是快，可也有不好的一面，那就是数据量大占用内存也大，并且在excel中调用paste方法时，需要锁定输入，这使用起来，就有点不方便了

　　这里我为大家介始一种比较好的方法，使用文件流的方式，通过tfilestream直接写入excel文件。我写了一个函数，通过它可将数据集中的数据直接导入到excel文件中。我测试了一下，1m的数据，不到十秒就完成了。附源程序。

　　首先在你的程序中定义以下几个数组：

arxlsbegin: array[0..5] of word = ($809, 8, 0, $10, 0, 0);

arxlsend: array[0..1] of word = ($0a, 00);

arxlsstring: array[0..5] of word = ($204, 0, 0, 0, 0, 0);

arxlsnumber: array[0..4] of word = ($203, 14, 0, 0, 0);

arxlsinteger: array[0..4] of word = ($27e, 10, 0, 0, 0);

arxlsblank: array[0..4] of word = ($201, 6, 0, 0, $17);

　　接着调用下面的函数。

procedure exportexcelfile(filename: string; bwritetitle: boolean; adataset: tdataset);
var
　i, j: integer;
　col, row: word;
　abookmark: tbookmark;
　afilestream: tfilestream;
　procedure inccolrow; //增加行列号
begin
　if col = adataset.fieldcount - 1 then
　begin
　　inc(row);
　　col :=0;
　end
　else
　　inc(col);
　end;

procedure writestringcell(avalue: string);//写字符串数据
var
　l: word;
begin
　l := length(avalue);
　arxlsstring[1] := 8 + l;
　arxlsstring[2] := row;
　arxlsstring[3] := col;
　arxlsstring[5] := l;
　afilestream.writebuffer(arxlsstring, sizeof(arxlsstring));
　afilestream.writebuffer(pointer(avalue)^, l);
　inccolrow;
end;

procedure writeintegercell(avalue: integer);//写整数
var
　v: integer;
begin
　arxlsinteger[2] := row;
　arxlsinteger[3] := col;
　afilestream.writebuffer(arxlsinteger, sizeof(arxlsinteger));
　v := (avalue shl 2) or 2;
　afilestream.writebuffer(v, 4);
　inccolrow;
end;

procedure writefloatcell(avalue: double);//写浮点数
begin
　arxlsnumber[2] := row;
　arxlsnumber[3] := col;
　afilestream.writebuffer(arxlsnumber, sizeof(arxlsnumber));
　afilestream.writebuffer(avalue, 8);
　inccolrow;
end;

begin
if fileexists(filename) then deletefile(filename); //文件存在，先删除
　afilestream := tfilestream.create(filename, fmcreate);
　try
　　//写文件头
　　afilestream.writebuffer(arxlsbegin, sizeof(arxlsbegin));
　　//写列头
　　col := 0; row := 0;
　　if bwritetitle then
　　begin
　　　for i := 0 to adataset.fieldcount - 1 do
　　　　writestringcell(adataset.fields[i].fieldname);
　　　end;
　　　//写数据集中的数据
　　　adataset.disablecontrols;
　　　abookmark := adataset.getbookmark;
　　　adataset.first;
　　　while not adataset.eof do
　　　begin
　　　　for i := 0 to adataset.fieldcount - 1 do
　　　　　case adataset.fields[i].datatype of
　　　　　　ftsmallint, ftinteger, ftword, ftautoinc, ftbytes:
　　　　　　writeintegercell(adataset.fields[i].asinteger);
　　　　　　ftfloat, ftcurrency, ftbcd:
　　　　　　writefloatcell(adataset.fields[i].asfloat)
　　　　　else
　　　　　　writestringcell(adataset.fields[i].asstring);
　　　　　end;
　　　　　adataset.next;
　　　　end;
　　　　//写文件尾
　　　　afilestream.writebuffer(arxlsend, sizeof(arxlsend));
　　　　if adataset.bookmarkvalid(abookmark) then adataset.gotobookmark(abookmark);
　　　　finally
　　　　　afilestream.free;
　　　　adataset.enablecontrols;
　　　end;
　end;

　　以上程序，在delphi6中通过测试！