16,749
社区成员
发帖
与我相关
我的任务
分享
var
y:integer;
tsList:TStringList;
s,filename:string;
aSheet:variant;
xl:OleVariant;
savedialog:TSaveDialog;
begin
Result:=true;
try
xl:=CreateOleObject('Excel.Application');
xl.workbooks.add;
except
showmessage('无法调用excel');
exit;
end;
savedialog:=TSaveDialog.Create(nil);
savedialog.FileName:=sfilename;
savedialog.Filter:='Excel文件(*.xlsx)|*.xlsx';
if savedialog.Execute then
begin
if FileExists(savedialog.FileName) then
try
if messagebox(handle,'该文件已经存在是否要覆盖','提示',MB_YESNO)=IDYES then
deletefile(PChar(savedialog.FileName))
else
begin
xl.quit;
savedialog.Free;
Exit;
end;
except
xl.quit;
savedialog.Free;
screen.Cursor:=crDefault;
Exit;
end;
filename:=savedialog.FileName;
end;
savedialog.Free;
if filename='' then
begin
Result:=true;
xl.quit;
Exit;
end;
aSheet:=xl.WorkSheets.Item[1];
tsList:=TStringList.Create;
s:='';
for y:=0 to ADOQuery1.FieldCount-1 do
begin
s:=s+adoquery1.fields.fields[y].FieldName+#9;
Application.ProcessMessages;
end;
tsList.Add(s);
try
try
ADOQuery1.First;
while not ADOQuery1.Eof do
begin
s:='';
for y:=0 to ADOQuery1.FieldCount-1 do
begin
s:=s+ADOQuery1.Fields[y].AsString+#9;
Application.ProcessMessages;
end;
tsList.Add(s);
ADOQuery1.Next;
end;
Clipboard.AsText:=tsList.Text;
except
Result:=false;
end;
finally
tsList.Free;
end;
aSheet.paste;
messagebox(handle,'数据导出完毕','提示',MB_YESNO);
try
if copy(FileName,length(FileName)-4,4)<>'.xlsx' then
FileName:=FileName+'.xlsx';
xl.ActiveWorkBook.SaveAs(FileName);
except
xl.quit;
screen.Cursor:=crDefault;
Exit;
end;
xl.visible:=false;
xl.quit;
xl:=UnAssigned;
end;