Delphi导出数据的多种方法
//Dxdbgrid，则直接用SaveToexcel即可
//使用 ExcelWithOdbc 控件
function TDataModule1.GetDataToFile(DsData: TObject): Boolean; //用于将数据导入文件中
var
DataSet: TCustomADODataSet;
FileName: string;
FileType: string;
begin
if not ((DsData is TCustomADODataSet) or (DsData is TDBGrid) or (DsData is TdxDBGrid)) then
begin
Application.MessageBox('警告：目前不支持此数据集！', '警告', MB_OK + MB_ICONERROR);
exit;
end;
if (DsData is TCustomADODataSet) then
DataSet := DsData as TCustomADODataSet
// DBGrid
else if (DsData is TDBGrid) then
DataSet := TDBGrid(DsData).DataSource.DataSet as TCustomADODataSet
// dxDBGrid
else if (DsData is TdxDBGrid) then
DataSet := TdxDBGrid(DsData).DataSource.DataSet as TCustomADODataSet;
if DataSet.isEmpty then
begin
Application.MessageBox('警告：数据集中没有数据！', '警告', MB_OK + MB_ICONWARNING);
exit;
end;
if (DsData is TdxDBGrid) then
begin //如果是当前所传入的参数是Dxdbgrid，则直接用SaveToexcel即可！
if Application.MessageBox('如果保存为Excle文件请选择Yes，保存OpenOffice格式请选择No ！', '提示', mb_yesNO + mb_defbutton1 + mb_iconinformation) = idyes then
begin
QCMMainFrm.GetExcelName.Options := [ofAllowMultiSelect, ofFileMustExist];
QCMMainFrm.GetExcelName.Filter := 'Excel files (*.xls)|*.XLS';
FileType := 'XLS';
end
else
begin
QCMMainFrm.GetExcelName.Options := [ofAllowMultiSelect, ofFileMustExist];
QCMMainFrm.GetExcelName.Filter := 'Excel files (*.csv)|*.CSV';
FileType := 'CSV';
end;
if QCMMainFrm.GetExcelName.Execute then
begin
try
FileName := QCMMainFrm.GetExcelName.FileName;
if pos('.', FileName) <= 0 then
FileName := FileName + '.' + FileType;
if FileExists(FileName) = true then
begin
if Application.MessageBox(PChar('文件' + FileName + '已经存在，是否覆盖？'), '提示', MB_YESNO + MB_ICONWARNING) = idNo then
exit;
try
DeleteFile(pchar(FileName));
except
Application.MessageBox('请重新指定文件名！', '出现错误', MB_ICONWARNING + MB_OK);
end;
end;
if FileType = 'XLS' then
TdxDBGrid(DsData).SaveToXLS(FileName, true)
else
TdxDBGrid(DsData).SaveToText(FileName, true, ',', '', ''); //保存成以逗号为分隔符号的文本文件。
Result := true;
application.MessageBox('提示：数据保存成功！', '提示', mb_ok + mb_iconinformation);
if (Application.MessageBox('文件保存成功，是否打开？', '提示', MB_ICONINFORMATION + MB_YESNO) = IDYES) then
ShellExecute(GetDesktopWindow, 'open', PChar(FileName), nil, PChar(ExtractFileDir(FileName)), SW_SHOWMAXIMIZED);
except
Result := false;
application.MessageBox('警告：数据保存失败，请重试！', '警告', mb_ok + mb_iconerror);
exit;
end;
end;
end
else
begin
QCMMainFrm.ExcelWithOdbc.DataItems.Clear;
QCMMainFrm.ExcelWithOdbc.DataItems.Add;
if (DsData is TCustomADODataSet) then
QCMMainFrm.ExcelWithOdbc.DataItems.Items[0].DataSet := DsData as TCustomADODataSet
else if (DsData is TDBGrid) then
QCMMainFrm.ExcelWithOdbc.DataItems.Items[0].DBGrid := DsData as TDBGrid
else if (DsData is TdxDBGrid) then
QCMMainFrm.ExcelWithOdbc.DataItems.Items[0].DxDBGrid := DsData as TdxDBGrid;
Result := False;
try
QCMMainFrm.ExcelWithOdbc.AutoGetFileName := true;
QCMMainFrm.ExcelWithOdbc.AutoOpen := true;
QCMMainFrm.ExcelWithOdbc.ExcelFileName := '';
QCMMainFrm.ExcelWithOdbc.Execute();
Result := true;
except
Result := false;
application.MessageBox('警告：数据保存失败，请重试！', '警告', mb_ok + mb_iconerror);
exit;
end;
end;
end;
//cxgrid导出数据
Uses cxExportGrid4Link;
if SaveDlg.Execute then
begin
if SaveDlg.FileName='' then
begin
Application.Messagebox(Pchar('请输入文件名！'),
Pchar('提示'),Mb_IconInforMation+MB_OK);
exit;
end;
if FileExists(SaveDlg.FileName) then
begin
if Application.Messagebox(Pchar('该目录下已存在这个文件，要替换吗？'),
Pchar('提示'),Mb_IconInforMation+MB_YESNO)=ID_NO then Exit;
DeleteFile(SaveDlg.FileName);
end;
ExportGrid4ToExcel(SaveDlg.FileName,
cxGrid1,
True,
True,
false); //字符串形式
Application.Messagebox(Pchar('成功汇出数据！' + char(13) + SaveDlg.FileName),
Pchar('提示'),Mb_IconInforMation+MB_OK);
end;
//StringList方法
procedure TfmMain.SaveDxGridToCSV(DxGrid: TDxDBGrid; ExcelFileName: string =
'');
var
i, j, SelectCount: integer;
s, s1: string;
theStringList: Tstringlist;
FileName: string;
OutFieldIndex: array of integer;
Book1: Pointer;
begin
if not DxGrid.DataSource.DataSet.Active then
Exit;
if ExcelFileName <> '' then
SaveDialog1.FileName := ExcelFileName;
if not SaveDialog1.Execute then
Exit;
FileName := SaveDialog1.FileName;
if trim(FileName) = '' then
Exit;
if (length(FileName) < 4) or (UpperCase(Copy(FileName, length(FileName) - 3,
4)) <> '.CSV') then
FileName := FileName + '.csv';
DxGrid.DataSource.DataSet.DisableControls;
Book1 := DxGrid.DataSource.DataSet.GetBookmark;
fmSelectFields := TfmSelectFields.Create(Self);
for i := 0 to DxGrid.ColumnCount - 1 do
begin
if DxGrid.Columns[i].Visible then
begin
with fmSelectFields.ListView1.Items.Add do
begin
Caption := DxGrid.Columns[i].Caption;
SubItems.Add(inttostr(DxGrid.Columns[i].Field.Index));
Checked := True;
end;
end;
end;
try
if not (fmSelectFields.ShowModal = mrOK) then
Exit;
SelectCount := 0;
for i := 0 to fmSelectFields.ListView1.Items.Count - 1 do
begin
if fmSelectFields.ListView1.Items[i].Checked then
SelectCount := SelectCount + 1;
end;
s := '';
//添加字段名
if (SelectCount = 0) or (SelectCount = fmSelectFields.ListView1.Items.Count)
then
begin
SelectCount := fmSelectFields.ListView1.Items.Count;
SetLength(OutFieldIndex, SelectCount);
for i := 0 to SelectCount - 1 do
begin
s := s + '"' + StringReplace(fmSelectFields.ListView1.Items[i].Caption,
'"', '""', [rfReplaceAll]) + '",';
OutFieldIndex[i] :=
StrToInt(fmSelectFields.ListView1.Items[i].SubItems[0]);
end;
end
else
begin
SetLength(OutFieldIndex, SelectCount);
j := 0;
for i := 0 to fmSelectFields.ListView1.Items.Count - 1 do
begin
if fmSelectFields.ListView1.Items[i].Checked then
begin
s := s + '"' +
StringReplace(fmSelectFields.ListView1.Items[i].Caption,
'"', '""', [rfReplaceAll]) + '",';
OutFieldIndex[j] :=
StrToInt(fmSelectFields.ListView1.Items[i].SubItems[0]);
inc(j);
end;
end;
end;
theStringList := TStringList.Create;
Delete(s, length(s), 1);
theStringList.Add(s);
with DxGrid.DataSource.DataSet do
begin
First;
while not Eof do
begin
s := '';
for i := 0 to SelectCount - 1 do
begin
s1 := Fields[OutFieldIndex[i]].DisplayText;//AsString;
if Fields[OutFieldIndex[i]].DataType = ftString then
s1 := '''' + StringReplace(s1, '"', '""', [rfReplaceAll]);
s := s + '"' + (s1) + '",';
end;
Next;
System.Delete(s, length(s), 1);
theStringList.add(s);
end;
end;
theStringList.savetofile(FileName);
theStringList.Clear;
theStringList.Free;
if (Application.MessageBox('文件成功保存，是否要现在打开文件？', '提示',
MB_ICONQUESTION + MB_YESNO) = IDYES) then
ShellExecute(GetDesktopWindow, 'open', PChar(FileName), nil,
PChar(ExtractFileDir(FileName)), SW_SHOWMAXIMIZED);
finally
fmSelectFields.Free;
fmSelectFields := nil;
DxGrid.DataSource.DataSet.GotoBookmark(Book1);
DxGrid.DataSource.DataSet.EnableControls;
end;
end;
//EXCEL OLE对象
procedure adoquerytoexcel(Aadoquery:TCustomADODataSet;sheetname:string='');
var
XLApp: Variant;
i:integer;
Sheet: Variant;
begin
if MessageDlg('你的电脑上是否安装Excel？',mtConfirmation, [mbYes, mbNo], 0)=mrYes then
begin
if Aadoquery.IsEmpty then exit;
// if Aadoquery.RecordCount=0 then exit;
try
XLApp:= CreateOleObject('Excel.Application');
XLApp.Visible := True;
XLApp.Workbooks.Add(-4167);
if sheetname='' then sheetname:='系统数据';
XLApp.Workbooks[1].WorkSheets[1].Name :=sheetname;
Sheet := XLApp.Workbooks[1].WorkSheets[1];
for i := 1 to Aadoquery.fieldcount do
begin
Sheet.Cells[1, i] :=Aadoquery.fields[i-1].FieldName;
end;
sheet.cells[2,1].copyfromrecordset(AAdoQuery.recordset);
except
NewDataToExcel(Aadoquery);
end;
end
else
begin
MainForm.toopenoffice(Aadoquery);
end;
end;
//逐条导出
procedure TfmFabricPlanning.SaveToFileClick(Sender: TObject);
var
FileName,Str2 :String;
Str :TStringList;
I :integer;
begin
if GetExcelName.Execute then
begin
FileName := GetExcelName.FileName;
if uppercase(copy(FileName,length(FileName)-3,4)) <> '.CSV' then
FileName := FileName + '.CSV';
Str := TStringList.Create;
//HEAD
Str.Add('"缸号","头缸状态","复板OK","用途","序列","交期","缸要求量","排单号","品名","要求重量","要求数量","单位","可备布量","客户","纱批","纱支布种"');
//record
for I := 0 to lvwBatch.items.count - 1 do
begin
Str2 := '"'+ lvwBatch.Items[i].Caption + '"';
Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[0] +'"';
Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[1] +'"';
Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[2] +'"';
Str2 := Str2+',"''' + lvwBatch.Items[i].SubItems.Strings[3] +'"';
Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[4] +'"';
Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[5] +'"';
Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[6] +'"';
Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[7] +'"';
Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[8] +'"';
Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[9] +'"';
Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[10] +'"';
Str2 := Str2+',"' + lvwBatch.Items[i].SubItems.Strings[11] +'"';
Str2 := Str2+',"' + StringReplace(lvwBatch.Items[i].SubItems.Strings[12],'"','""',[rfReplaceAll]) +'"';
Str2 := Str2+',"' + StringReplace(lvwBatch.Items[i].SubItems.Strings[13],'"','""',[rfReplaceAll]) +'"';
Str2 := Str2+',"' + StringReplace(lvwBatch.Items[i].SubItems.Strings[14],'"','""',[rfReplaceAll]) +'"';
Str.Add(Str2);
end;
Str.SaveToFile(FileName);
if (Application.MessageBox('文件成功保存，是否要现在打开文件？', '提示',
MB_ICONQUESTION + MB_YESNO) = IDYES) then
ShellExecute(GetDesktopWindow, 'open', PChar(FileName), nil,
PChar(ExtractFileDir(FileName)), SW_SHOWMAXIMIZED);
end;
end;
//dbgrideh导出数据
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons, RzBckgnd, ADODB,
dbgridehimpexp, DBGridEh, RzLabel;
type
TfrmminiExport = class(TForm)
RzBackground1: TRzBackground;
cmbfmt: TComboBox;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Bevel1: TBevel;
SaveDialog1: TSaveDialog;
labHits: TRzLabel;
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmminiExport: TfrmminiExport;
//导出资料使用的变量
qryExportname:string;
qryExportDBGridEh:TDBGrideh;
qryADOQ:tadoquery;
implementation
{$R *.dfm}
uses U_SfisPCDataModule, u_pub_func, u_qryPH;
procedure TfrmminiExport.BitBtn1Click(Sender: TObject);
var
expclass:tdbgridehexportclass;
filename:string;
begin
// ShowMessage('Go...');
//ShowMessage(frmsample.cmbgd.Text);
//modalResult := mrnone;
if cmbfmt.Text='' then
begin
application.MessageBox('请选择汇出资料的格式,谢谢!','提示',mb_iconinformation+mb_ok);
exit;
end;
//ShowMessage('1');
if qryADOQ.Eof then
begin
showmessage('没有资料可以汇出，谢谢!');
exit;
end;
//ShowMessage('2');
if not qryADOQ.Active then
begin
showmessage('数据集未开启,请先查询后再尝试汇出资料!');
exit;
end;
//ShowMessage('Filefmt...');
case cmbfmt.ItemIndex of
0:
begin
expclass:=tdbgridehexportasxls;
//ShowMessage('xls...');
filename:='.xls';
savedialog1.Filter := '*.xls|*.xls'
end;
1:
begin
expclass:=tdbgridehexportastext;
filename:='.txt';
savedialog1.Filter := '*.txt|*.txt'
end;
2:
begin
expclass:=tdbgridehexportashtml;
filename:='.html';
savedialog1.Filter := '*.html|*.html'
end;
3:
begin
expclass:=tdbgridehexportasrtf;
filename:='.rtf';
savedialog1.Filter := '*.rtf|*.rtf'
end;
4:
begin
expclass:=tdbgridehexportascsv;
filename:='.csv';
savedialog1.Filter := '*.csv|*.csv'
end;
else
savedialog1.Filter := '*.*|*.*';
end;
if savedialog1.Execute then
begin
try
//showmessage(sample.cmbgd.Text);
//exit;
//filename:=sample.cmbgd.Text + filename;
//savedialog1.FileName:=filename;
//savedialog1.FileName := + filename;
//filename := savedialog1.FileName;
//ShowMessage(savedialog1.FileName);
if savedialog1.FileName = '' then
begin
SfisPCDataModule.systemHits('请输入文件名, 谢谢...', '提示', 0);
exit;
end;
FileName := savedialog1.FileName + FileName;
//ShowMessage(FileName);
if fileexists(FileName) then
begin
if application.MessageBox('文件已存在,是否覆盖 ?','提示',mb_iconinformation+mb_yesno)=idyes then
deletefile(filename)
else
exit
end;
//开始汇出资料.........
savedbgridehtoexportfile(expclass, qryExportDBGridEh, filename, true);
//savedbgridehtoexportfile(expclass,frmsample.DBGridEh2,'D:\111.txt',true);
application.MessageBox(PCHAR('成功汇出 ' + IntToStr(qryADOQ.RecordCount) + ' 笔资料! '),'提示',mb_iconinformation+mb_ok);
except
application.MessageBox('出现错误,汇出资料失败! ','提示',mb_iconinformation+mb_ok);
end;
end;
modalResult := mrOK;
end;
