首页  编辑  

利用Excel的内置功能导入数据

Tags: /超级猛料/Office.OA自动化/Excel/   Date Created:

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,不过没有进度而已。