将adoquery中的数据导入excel文件,使用QueryTables,有问题???

[nidazhi]

我想将adoquery中的数据导入excel文件,别的贴子上的方法有点慢,看到一个关于QueryTables的,速度很快.
但在excel97下报错"参数错误",在excel2000下是可以的.
那位高手知道此问题的解决方法.
关键是以下这句代码
XLQuery := xlSheet.QueryTables.Add(ADOQueryExcel.Recordset,xlSheet.Range['A1']);



procedure TPub.QueryTablesToExcelFile(ADOQueryExcel: TADOQuery);
var
xlVersion : string;
XLApp: Variant;
XLSheet: Variant;
XLQuery: Variant;
SaveDialog:TSaveDialog;
StrSaveFile:string;
begin

if ADOQueryExcel.IsEmpty then
begin
messagebox(application.Handle,'没有任何数据,不能进行保存','警告',mb_ok);
abort;
end;

SaveDialog:=TSaveDialog.Create(Nil);
SaveDialog.Filter := 'Microsoft Excel 文件|*.xls';
SaveDialog.Execute;
StrSaveFile:=SaveDialog.FileName;
if length(StrSaveFile)=0 then
begin
exit;
end;
try
screen.Cursor:=crHourGlass;
try
XLApp := CreateOleObject('Excel.Application');
XLApp.WorkBooks.Add(-4167);
XLApp.WorkBooks[1].WorkSheets[1].Name := '导出数据';
XLSheet := XLApp.WorkBooks[1].WorkSheets['导出数据'];
except
MessageBox(GetActiveWindow,'无法调用Mircorsoft Excel! '+chr(13)+chr(10)+
'请检查是否安装了Mircorsoft Excel。','提示',MB_OK+MB_ICONINFORMATION);
Exit;
end;
xlVersion := XLApp.Version;
XLQuery := xlSheet.QueryTables.Add(ADOQueryExcel.Recordset,xlSheet.Range['A1']);
XLQuery.FieldNames := true;
XLQuery.RowNumbers := false;
XLQuery.FillAdjacentFormulas := false;
XLQuery.PreserveFormatting := true;
XLQuery.RefreshOnFileOpen := false;
XLQuery.BackgroundQuery := true;
XLQuery.SavePassword := true;
XLQuery.SaveData := true;
XLQuery.AdjustColumnWidth := true;
XLQuery.RefreshPeriod := 0;
XLQuery.PreserveColumnInfo := true;
XLQuery.FieldNames := true;
XLQuery.Refresh(false);

XLSheet.Cells.EntireColumn.AutoFit;

XLApp.activeworkbook.saveas(StrSaveFile);
Application.ProcessMessages;
XLApp.Application.Quit;
XLSheet := 'Unassigned';
XLApp := 'Unassigned';
Showmessage('成功导出数据(列为日期类型的需重新设置单元格格式)!');
Finally
SaveDialog.Free;
screen.Cursor := crDefault;
end;
end;

[nidazhi]

up

[dazhinee]

up一下

[ercnet]

数据导出EXCEL............我觉得以下这个方法最好,,,(别人的,不是我的).一直想把它变为LISTVIEW导出为EXCEL却没办法......谁知道帮我一下????
=============================


首先要创建一个公共单元，名字你们可以随便起。
以下是我创建的公共单元的全部代码：
unit UnitDatatoExcel;
interface
uses
Windows,Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,
DB, ComObj;
type
TKHTMLFormatCellEvent = procedure(Sender: TObject; CellRow,CellColumn: Integer; FieldName: string;
var CustomAttrs, CellData: string) of object;
TDataSetToExcel = class(TComponent)
private
FDataSet: TDataSet;
FOnFormatCell: TKHTMLFormatCellEvent;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Transfer(const FileName: string; Title: string = '');
published
property DataSet: TDataSet read FDataSet write FDataSet;
end;
implementation
constructor TDataSetToExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataSet := nil;
end;
destructor TDataSetToExcel.Destroy;
begin
inherited;
end;
procedure TDataSetToExcel.Transfer(const FileName:string;Title:string = '');
var
ExcelApp, MyWorkBook: Variant;
i: byte;
j, a: integer;
s, k, b, CustomAttrs: string;
begin
try
ExcelApp := CreateOleObject('Excel.Application');
MyWorkBook := CreateOleObject('Excel.Sheet');
except
on Exception do raise exception.Create('无法打开Excel文件，请确认已经安装Execl')
end;
MyWorkBook := ExcelApp.WorkBooks.Add;
MyWorkBook.WorkSheets[1].Range['A1:D1'].Merge(True);
MyWorkBook.WorkSheets[1].Range['A1:D2'].HorizontalAlignment := $FFFFEFF4;
MyWorkBook.WorkSheets[1].Cells[1, 1].Value := Title;
with FDataSet do
begin
i := 2;
for j := 0 to FieldCount - 1 do
begin
if Fields[j].Visible then
begin
b := Fields[j].DisplayLabel;
CustomAttrs := '';
if Assigned(FOnFormatCell) then
FOnFormatCell(Self, 1, i,
Fields[j].FieldName, CustomAttrs, b);
MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := b;
end;
end;
i := 3;
Close;
Open;
First;
a := 2;
while not Eof do
begin
for j := 0 to FieldCount - 1 do
begin
if Fields[j].Visible then
begin
CustomAttrs := '';
k := Fields[j].Text;
if Assigned(FOnFormatCell) then
FOnFormatCell(Self, i, a,
Fields[j].FieldName, CustomAttrs, k);
MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := k;
inc(a);
end;
end;
Inc(i);
Next;
end;
end;
s := 'A3:D' + IntToStr(i - 1);
s := 'A1:D' + IntToStr(i - 1);
MyWorkBook.WorkSheets[1].Columns[1].ColumnWidth := 20;
MyWorkBook.WorkSheets[1].Columns[4].ColumnWidth := 25;
MyWorkBook.WorkSheets[1].Rows[1].RowHeight := 50;
MyWorkBook.WorkSheets[1].Rows[1].VerticalAlignMent := $FFFFEFF4;
MyWorkBook.WorkSheets[1].Range[s].Font.Name := '仿宋';
s := 'A2:D' + IntToStr(i - 1);
MyWorkBook.WorkSheets[1].Range[s].Borders.LineStyle := 1;
MyWorkBook.WorkSheets[1].PageSetup.CenterHorizontally := True;
MyWorkBook.WorkSheets[1].PageSetup.PrintTitleRows := 'A1';
try
MyWorkBook.Saveas(FileName);
MyWorkBook.Close;
except
MyWorkBook.Close;
end;
ExcelApp.Quit;
ExcelApp := UnAssigned;
end;
end.
然后在调用它的单元里引用它就行了。
下面是调用它的代码：
procedure ToGetherExcel(NewData: TDataSet; NewString: string);
var
DataExcel: TDataSetToExcel;
saveDlg: TSaveDialog;
begin
saveDlg := TSaveDialog.Create(nil); //创建一个存储对话框
DataExcel := TDataSetToExcel.Create(nil);
try
saveDlg.Filter := 'Execl 文件(*.XLS)|*.XLS';
saveDlg.DefaultExt := 'XLS';
saveDlg.FileName := NewString;
if saveDlg.Execute then
begin
DataExcel.DataSet := NewData; //连接的数据集
DataExcel.DataSet.DisableControls;
DataExcel.Transfer(saveDlg.FileName, NewString);
DataExcel.DataSet.EnableControls;
AlterMesg('导出完毕', '提示信息');
end;
finally
saveDlg.Free;
DataExcel.Free;
end;
end;
=======

[nidazhi]

怎么没人回答啊,自己UP一下.

[yaven365]

帮你up一下

[nidazhi]

楼上的方法我知道,但速度太慢了,要一个一个单元格地写.

用querytables速度很快.但只能在excel2000中用

[gaozhu2003]

我覺得這個方法很快﹐而且沒安裝EXCEL也能導出﹐保存的文件格式應為.CSV,這種文件在
EXCEL97,EXCEL2000中都能打開。
procedure OutExcelFile(AQuery:TADOQuery;ASaveDialog:TSaveDialog);
var i,j:integer;//i--field,j--record
s:string;//record string
theStringList:Tstringlist;//temp storage
begin
theStringList:=Tstringlist.Create;
if ASaveDialog.Execute then
begin
try
s:='';
with AQuery do
begin
for i:=0 to FieldCount-1 do
begin
s:=s+Fields[i].DisplayLabel+',';
end;
theStringList.Add(s);
for j:=0 to (RecordCount-1) do
begin
s:='';
for i:=0 to (FieldCount-1) do
begin
s:=s+Fields[i].AsString+',';
end;
theStringList.Add(s);
next;
end;
//將SaveDialog組件保存的文件設為.CSV格式
theStringList.SaveToFile(ASaveDialog.FileName);
end;
finally
theStringList.Free;
end;
end;
end;

[Hedonism]

来此学习

[nidazhi]

没有人知道吗?