[DELPHI]TQuery的结果到入Excel

unit ExcelTest;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls,db,DBTables, ComCtrls;
type
TForm1 = class(TForm)
  Button1: TButton;
  Query1: TQuery;
  procedure Button1Click(Sender: TObject);
private
  { Private declarations }
public
  { Public declarations }
  procedure WriteDatasetToExcel(AQueryName: TQuery; AStrVar: String);
end;

var
  Form1: TForm1;

implementation

uses Comobj;

{$R *.DFM}

{ TForm1 }

procedure TForm1.WriteDatasetToExcel(AQueryName: TQuery; AStrVar: String);
var
  EclApp,WorkBook : Variant;
  xlsFileName : String ;
  I : Integer ;
  column : Integer ;
  Row : Integer ;
  Fdate:TDateTime;
  Year, Month, Day, Hour, Min, Sec, MSec: Word;
  StrDate:String ;
  StrDate1:String ;
  Begin
    Fdate:=now ;
    DecodeDate(Fdate, Year, Month, Day);
    DecodeTime(Fdate, Hour, Min, Sec, MSec);
    StrDate:=formatdatetime('yyyy-mm-dd-hh-mm-ss',Fdate) ;
    StrDate1:=formatdatetime('yyyy/mm/dd hh:mm:ss',Fdate) ;
    If AStrVar='Excel文件测试' Then
    Begin
      xlsfilename :='Excel文件测试' ;
    End ;

    Try
       EclApp := CreateOleObject('Excel.Application');
       WorkBook:=CreateOleObject('Excel.Sheet');
    Except
      ShowMessage('您的计算机上没有 Microsoft Excel!');
    Exit;
  end;
  try
    workBook:=EclApp.workBooks.Add ;
    row:=2;
    EclApp.Workbooks.Item[1].Activate;
    eclApp.Cells.font.colorindex:=5 ;
    EclApp.Activesheet.Cells(1,1):=AStrVar ;
    For I := 1 To AQueryName.FieldCount Do
    EclApp.Activesheet.Cells(2,I):=AQueryName.Fields[I-1].FieldName ;
    If Not AQueryName.Active Then AQueryName.Active := True ;
    AQueryName.First ;
    While Not(AQueryName.Eof) do
    begin
       column:=1;
       for i:=1 to AQueryName.FieldCount do
       begin
          eclApp.Cells.Item[row+1,column]:=AQueryName.fields[i-1].AsString;
          column:=column+1;
       end;
       AQueryName.Next;
       row:=row+1;
    End ;
    WorkBook.saveas(xlsFileName);
    WorkBook.close;
    WorkBook:=eclApp.workBooks.Open(xlsFileName);
    if MessageDlg('xlsFileName'+'对该文件是否保存?',
    mtConfirmation,[mbYes, mbNo], 0) = mrYes then
    WorkBook.save
Else
   workBook.Saved := True;
   WorkBook.Close;
   eclApp.Quit;
   eclApp:=Unassigned;
   except
   ShowMessage('Excel 文件保存失败');
   WorkBook.close;
   eclApp.Quit; {释放VARIANT变量}
   eclApp:=Unassigned;

  end;
   ShowMessage('EXCEL 文件保存完毕') ;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
WriteDatasetToExcel(query1,'Excel文件测试');
end;

end.

本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/whbo/archive/2004/12/28/232423.aspx