uses ComObj;
procedure DataSetToExcel(ADataSet: TCustomADODataSet; const AFileName: string);
var
Table, ExcelApp, ExcelBook, ExcelSheet: Variant;
begin
if not ADataSet.Active then Exit;
ExcelApp := CreateOleObject('Excel.Application');
ExcelBook := ExcelApp.WorkBooks.Add;
ExcelSheet := ExcelBook.Sheets.Item[1];
Table := ExcelSheet.QueryTables.Add(ADataSet.Recordset, ExcelSheet.Range['A1']);
Table.Refresh(True);
ExcelBook.Close(True, AFileName);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOTable1.Open;
DataSetToExcel(ADOTable1, 'c:\aa.xls');
end;
---------------------------------------
type
TForm1 = class(TForm)
ADOQuery1: TADOQuery;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
FExcelBook: TExcelWorkBook;
FExcelSheet: TExcelWorkSheet;
FExcelApp: TExcelApplication;
procedure DataSetToExcel(AFileName: string);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.DataSetToExcel(AFileName: string);
begin
try
FExcelApp.Visible[0] := False;
try
FExcelBook.ConnectTo(FExcelApp.Workbooks.Add(EmptyParam, 0));
except
raise Exception.Create('连接到Excel文件出错,可能是没有安装Excel软件');
end;
FExcelSheet.ConnectTo(FExcelBook.Worksheets[1] as _WorkSheet);
with FExcelSheet.QueryTables.Add(ADOQuery1.Recordset, FExcelSheet.Range['A3', EmptyParam], EmptyParam) do
begin
FieldNames := False;
Refresh(False);
end;
FExcelSheet.Columns.Item[3, EmptyParam].NumberFormatLocal := 'yyyy-mm-dd';
FExcelBook.SaveCopyAs(AFileName);
FExcelBook.Close(False);
finally
FExcelApp.Quit;
FExcelSheet.Disconnect;
FExcelBook.Disconnect;
FExcelApp.Disconnect;
end;
end;
{ TForm1 }
constructor TForm1.Create(AOwner: TComponent);
begin
inherited;
FExcelApp := TExcelApplication.Create(Self);
FExcelBook := TExcelWorkBook.Create(Self);
FExcelSheet := TExcelWorkSheet.Create(Self);
end;
destructor TForm1.Destroy;
begin
FExcelSheet.Free;
FExcelBook.Free;
FExcelApp.Free;
inherited;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := 'begin open';
with ADOQuery1 do
begin
if not Active then
begin
SQL.Text := 'select * from mytable';
Open;
end;
DataSetToExcel('c:\a.xls');
end;
end;
这是利用Excel内置的功能,其它的功能各位再试试了。
还有一篇是直接写Excel文件格式的:
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1051160
试过,两万的记录当然是写XLS格式快点,快他只是给出写一个Sheet的,而上面内置的,可以有多个Sheet,不过没有进度而已。