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;