Delphi DataSetToExcel的三种方法

function TWorkWindowForm.DataSetToExcel(cds_Temp: TClientDataSet; AcxGridDBTableView: TcxGridDBTableView; ToSavePath:string; var sMsg: string): Boolean;
var  
   XLS,WorkBook,WorkSheet: variant;
   i,m,n,Row,Col,RecNums: integer;
   sFieldName,
   SheetName,
   tmpSheetName: string;
   nSheetNums,nLoopCount,nMaxRows: Integer;
   cds_DataSet: TClientDataSet;
   dBeginTime: TDateTime;
begin
  Result := False;
  dBeginTime := Now;
  //检查数据完整性
  sMsg := '没有导出的数据或导出路径为空！';
  if not cds_Temp.Active then exit;
  if cds_Temp.RecordCount<=0 then exit;
  if AcxGridDBTableView.DataController.RecordCount<=0 then Exit;
  if ToSavePath = '' then Exit;

  if FileExists(ToSavePath) then
  begin
    CopyFile(PChar(ToSavePath),PChar('C:\temp.xls'),True);
    DeleteFile(ToSavePath);
  end;
  try
    RecNums := 0;
    nMaxRows := 65536;     //Excel2003最大行数
    nLoopCount := 1;       //循环次数----->针对循环sheet页
    Row := 2;              //从第2行开始写内容

    try
      XLS := createoleobject('Excel.Application');  //创建Excel工程
      WorkBook := XLS.WorkBooks.Add;  //新增一个工作簿
      WorkSheet := XLS.WorkSheets.Add; //新建一个Sheet
      XLS.Visible := False;
      SheetName := '数据目录1';  //第1个Sheet
      WorkSheet.Name := SheetName; //Sheet名称
      XLS.WorkSheets[SheetName].Activate;

      XLS.WorkSheets['Sheet1'].Activate; //设置一个活动的Sheet
      XLS.WorkSheets['Sheet1'].Delete;   //删除
      XLS.WorkSheets['Sheet2'].Activate;
      XLS.WorkSheets['Sheet2'].Delete;
      XLS.WorkSheets['Sheet3'].Activate;
      XLS.WorkSheets['Sheet3'].Delete;
    except
      CopyFile(PChar('C:\temp.xls'),PChar(ToSavePath),True);
      if FileExists('C:\temp.xls') then DeleteFile('C:\temp.xls');
      sMsg := '创建Excel失败,请确认安装Excel2003或以上版本！';
    end;

    try
      //写入表头
      m := AcxGridDBTableView.ItemCount;  //cxGrid列总数
      for i:=0 to m-1 do
      begin
        XLS.cells[1,i+1]:=AcxGridDBTableView.Columns[i].Caption;   //左上角第一个方格是[1,1]
      end;

      cds_DataSet := TClientDataSet.Create(nil);
      cds_DataSet.Data := cds_Temp.Data;
      RecNums := cds_DataSet.RecordCount;
      try//写入Excel数据
        cds_DataSet.DisableControls;
        cds_DataSet.First;
        while not cds_DataSet.Eof do
        begin
          for Col := 1 to m do
          begin
            sFieldName := AcxGridDBTableView.Columns[Col-1].DataBinding.FieldName;
            XLS.cells[Row,Col] := cds_DataSet.FieldByName(sFieldName).AsString;
          end;
        
          Inc(Row);
          if Row > nMaxRows then
          begin
            Inc(nLoopCount);   //循环次数
            //建立第下一个Sheet页,继续写数据
            SheetName := '数据目录'+inttostr(nLoopCount); //第i个Sheet
            WorkSheet := XLS.WorkSheets.Add; //新建一个Sheet
            XLS.Visible := False;
            WorkSheet.Name := SheetName; //Sheet名称
            XLS.WorkSheets[SheetName].Activate;

            //写入表头
            m := AcxGridDBTableView.ItemCount;  //cxGrid列总数
            for i:=0 to m-1 do
            begin
              XLS.cells[1,i+1]:=AcxGridDBTableView.Columns[i].Caption;   //左上角第一个方格是[1,1]
            end;
            Row := 2; //从第i个Sheet,第2行开始写内容
          end;

          cds_DataSet.Next;
        end;
      finally
        cds_DataSet.EnableControls;
        FreeAndNil(cds_DataSet);
      end;
    Except
      CopyFile(PChar('C:\temp.xls'),PChar(ToSavePath),True);
      if FileExists('C:\temp.xls') then DeleteFile('C:\temp.xls');
      sMsg := '写入Excel内容失败！';
    end;

      XLS.WorkBooks[1].SaveAs(ToSavePath, 56); //fileformat:=56 -- Office Excel 97-2003 format
  finally
    XLS.WorkBooks.Close; //关闭工作簿
    if not VarIsEmpty(XLS) then
       XLS.Quit;
    XLS := Unassigned;

    if FileExists('C:\temp.xls') then DeleteFile('C:\temp.xls');
  end;

  Result := True;
  n := SecondsBetween(Now,dBeginTime);
  Application.MessageBox(PChar('数据导出完毕，共计'+ inttostr(RecNums) + '条！【' + IntToStr(n) + '秒】'),'提示',MB_ICONINFORMATION + MB_OK);
end;

 

//第二种方法

function TWorkWindowForm.DataSetToExcel_ByClipbrd(DataSet: TClientDataSet; AcxGridDBTableView: TcxGridDBTableView; var sMsg: string): Boolean;
const
  xlNormal = -4143;
var
  sList: TStringList;
  sTitle, sData: string;
  WorkBook, WorkSheet: Variant;
  Excel: OleVariant;
  x, y, diff: Real;
  i, m, Cols,nRecCount, nLoopCount: Integer;
  SaveDialog: TSaveDialog;
  lv_sPath, sFieldName: string;
  cds_Temp: TClientDataSet;
  sExt, SheetName: string;
begin
  Result := False;
  if AcxGridDBTableView.DataController.RecordCount <= 0 then
  begin
    sMsg := '错误：没有检索数据！';
    Exit;
  end;
  if DataSet.IsEmpty then
  begin
    sMsg := '错误：没有检索到数据！';
    Exit;
  end;

  //获取保存文件名
  SaveDialog := TSaveDialog.Create(nil);
  try
    with SaveDialog do
    begin
      Filter := '*.xls|*.xls';
      if Execute then
        lv_sPath := SaveDialog.FileName;
      if lv_sPath = '' then
      begin
        sMsg := '错误：请输入文件名！';
        Exit;
      end;

      sExt := ExtractFileExt(lv_sPath);
      if UpperCase(sExt) <> UpperCase('.xls') then
        lv_sPath := lv_sPath + '.xls';
    end;
  finally
    FreeAndNil(SaveDialog);
  end;

  //判断是否存在文件
  if FileExists(lv_sPath) then
  begin
    if Application.MessageBox('该文件已经存在，要覆盖吗？', '询问', MB_YESNO + MB_ICONQUESTION) = IDYES then
    begin
      try
        DeleteFile(lv_sPath);
      except
        on E: Exception do
        begin
          sMsg := '错误：删除文件' + lv_sPath + '失败！';
          Exit;
        end;
      end;
    end
    else
    begin
      sMsg := '提示：未覆盖' + lv_sPath + '文件！';
      Exit;
    end;
  end;

  x := GetTickCount;  //开始时间
  //创建Excel
  try
    Excel := CreateOleObject('Excel.Application');
    WorkBook := Excel.WorkBooks.Add;  //新增一个工作簿
    WorkSheet := Excel.WorkSheets.Add;
    Excel.Visible := False;
    WorkSheet.Name := '数据目录1';   //Sheet名称
    Excel.WorkSheets['数据目录1'].Activate;

    //删除多余的Sheet
    Excel.WorkSheets['Sheet1'].Activate; //设置一个活动的Sheet
    Excel.WorkSheets['Sheet1'].Delete;   //删除
    Excel.WorkSheets['Sheet2'].Activate;
    Excel.WorkSheets['Sheet2'].Delete;
    Excel.WorkSheets['Sheet3'].Activate;
    Excel.WorkSheets['Sheet3'].Delete;
  except
    on E: Exception do
    begin
      sMsg := '错误：创建Excel失败,请确认安装Excel2003或以上版本--->' + e.Message;
      Exit;
    end;
  end;

  sList := TStringList.Create;
  cds_Temp := TClientDataSet.Create(nil);
  try
    cds_Temp.Data := DataSet.Data;  //复制数据
    nRecCount := cds_Temp.RecordCount;

    //写入每个Sheet页的第一行标题
    Cols := AcxGridDBTableView.ItemCount;  //cxGrid列总数
    for i:=0 to Cols-1 do
    begin
      sTitle := sTitle + AcxGridDBTableView.Columns[i].Caption + #9;   //左上角第一个方格是[1,1]
      Application.ProcessMessages;
    end;
    sList.Add(sTitle);

    try
      m := 1;
      nLoopCount := 1;  //第一Sheet页
      WorkSheet := Excel.Worksheets.Item[1];     //第1个Sheet页
      cds_Temp.First;
      while not cds_Temp.Eof do
      begin
        sData := '';
        for i := 1 to Cols do
        begin
          sFieldName := AcxGridDBTableView.Columns[i-1].DataBinding.FieldName;
          sData := sData + cds_Temp.FieldByName(sFieldName).AsString + #9;
          Application.ProcessMessages;
        end;
        sList.Add(sData);

        if m >= 3 then     //每个Sheet页允许3行数据
        begin
          //保存Sheet页
          Clipboard.AsText := sList.Text;
          WorkSheet.Paste;
          Clipboard.Clear;
          sList.Clear;
          sList.Add(sTitle);

          //准备下一个Sheet页
          Inc(nLoopCount);
          SheetName := '数据目录' + IntToStr(nLoopCount);
          WorkSheet := Excel.WorkSheets.Add; //新建一个Sheet
          Excel.Visible := False;
          WorkSheet.Name := SheetName;       //Sheet名称
//          Excel.WorkSheets[SheetName].Activate;
          WorkSheet := Excel.Worksheets.Item[1];     //第1个Sheet页

          //开始下一个Sheet页的处理
          m := 1;
          cds_Temp.Next;
          Continue;
        end;

        Inc(m);
        cds_Temp.next;
      end;
      Clipboard.Clear;
      Clipboard.AsText := sList.Text;
      WorkSheet.Paste;     //保存至第nSheetNo个Sheet页
    except
      on E: Exception do
      begin
        sMsg := 'E:Exception：拷贝数据异常--->' + e.Message;
        Exit;
      end;
    end;
  finally
    cds_Temp.Free;
    sList.Free;
  end;

  //保存Excel
  try
    Excel.ActiveWorkbook.SaveAs(lv_sPath, xlNormal, '', '', False, False);
    Excel.Visible := False; //true会自动打开已经保存的excel
    Excel.Quit;
    Excel := UnAssigned;

    y := GetTickCount;
    diff := (y-x)/1000; 
    sMsg := '数据导出完毕！【耗费' + FloatToStr(diff) + '秒】';
    Result := True;
  except
    on E: Exception do
    begin
      Excel.Quit;
      screen.cursor := crDefault;
      sMsg := 'E:Exception：保存Excel异常--->' + E.Message;
      Exit;
    end;
  end;
end;

 

//第三种方法

//导出数据到Excel
function TForm1.ToExcel(cxGridDBTableView: TcxGridDBTableView; var sMsg: string): Boolean;
var
  ExcelApp: Variant;
  i, j, k, m, n, x, y: integer;
  FileName,sExt: string;
  DlgSave: TsaveDialog;
  BookMark: TBookMark;
begin
  Result := False;

  if cxGridDBTableView.DataController.RecordCount = 0 then
  begin
    sMsg := '错误：没有可以导出的数据！';
    Exit;
  end;
  if cxGridDBTableView.DataController.DataSource.DataSet.IsEmpty then
  begin
    sMsg := '错误：数据集为空！';
    Exit;
  end;

  //获取保存路径
  DlgSave := TsaveDialog.Create(nil);
  try
    DlgSave.Filter := '*.xlsx|*.xlsx';
    if not DlgSave.Execute then
    begin
      sMsg := '错误：未保存文件路径！';
      Exit;
    end;
    FileName := DlgSave.FileName;
    if FileName = '' then
    begin
      sMsg := '错误：保存文件名为空！';
      Exit;
    end;
    sExt := ExtractFileExt(FileName);
    if sExt = '' then
    begin
      FileName := FileName + '.xlsx';
    end;
  finally
    FreeAndNil(DlgSave);
  end;

  if FileExists(FileName) then
  begin
    if Application.MessageBox(PChar('是否覆盖文件？'), '', MB_YESNO + MB_ICONQUESTION) = IDNO then
    begin
      sMsg := '错误：未覆盖相同文件！';
      Exit;
    end;
    try
      if not DeleteFile(FileName) then
      begin
        sMsg := '错误：无法删除此文件！';
        Exit;
      end;
    except
      on e: Exception do
      begin
        sMsg := '删除文件错误[Exception]：' + e.message;
        Exit;
      end;
    end;
  end;

  if not VarIsEmpty(ExcelApp) then
  begin
    ExcelApp.DisplayAlerts := False;
    ExcelApp.Quit;
    VarClear(ExcelApp);
  end;

  x := GetTickCount;  //开始计时
  try
    Application.ProcessMessages;
    ExcelApp := CreateOleObject('Excel.Application');
    ExcelApp.Caption := '深大调用Excel函数'; //'Microsoft Excel';
    ExcelApp.WorkBooks.Add;
    Application.ProcessMessages;
    ExcelApp.WorkSheets[1].Activate;         //第1个Sheet
  except
    on e: Exception do
    begin
      sMsg := '创建错误[Exception]：' + e.message;
      Exit;
    end;
  end;

  //第一行标题
  try
    k := 1;
    for i := 0 to cxGridDBTableView.ColumnCount - 1 do
    begin
      if cxGridDBTableView.Columns[i].Visible then
      begin
        ExcelApp.Cells[1, k] := cxGridDBTableView.Columns[i].Caption;
        k := k + 1;
      end; {if}
    end; {for}
    ExcelApp.rows[1].font.name := '宋体';
    ExcelApp.rows[1].font.size := 10;
    ExcelApp.rows[1].Font.Color := clBlack;
    ExcelApp.rows[1].Font.Bold := True;
  except
    on e: Exception do
    begin
      sMsg := '拷贝标题错误[Exception]：' + e.message;
      Exit;
    end;
  end;

  //写数据到Excel
  try
    cxGridDBTableView.DataController.DataSource.DataSet.DisableControls;
    try
      j := 1;
      m := cxGridDBTableView.DataController.DataSource.DataSet.RecordCount;
      BookMark := cxGridDBTableView.DataController.DataSource.DataSet.GetBookmark;
      for i := 0 to cxGridDBTableView.ColumnCount - 1 do
      begin
        if cxGridDBTableView.Columns[i].Visible then
        begin
          cxGridDBTableView.DataController.DataSource.DataSet.First;
          for k := 1 to cxGridDBTableView.DataController.DataSource.DataSet.RecordCount do
          begin
            ExcelApp.Cells[k + 1, j] := cxGridDBTableView.DataController.DataSource.DataSet.FieldByName(cxGridDBTableView.Columns[i].DataBinding.FieldName).Asstring;
            cxGridDBTableView.DataController.DataSource.DataSet.Next;
          end; {for}
          j := j + 1;
        end; {if}
      end; {for}

      for i := 1 to cxGridDBTableView.DataController.DataSource.DataSet.RecordCount + 1 do
        ExcelApp.rows[i].Font.SIZE := 9;
    finally
      cxGridDBTableView.DataController.DataSource.DataSet.GotoBookmark(BookMark);
      cxGridDBTableView.DataController.DataSource.DataSet.EnableControls;
    end;
  except
    on e: Exception do
    begin
      sMsg := '拷贝数据错误[Exception]：' + e.message;
      Exit;
    end;
  end;

  //保存Excel步骤
  try
    ExcelApp.Columns.AutoFit;
    ExcelApp.ActiveWorkBook.SaveAs(FileName);
    ExcelApp.WorkBooks.Close;
    ExcelApp.Quit;
    ExcelApp := Unassigned;
  except
    on e: Exception do
    begin
      sMsg := '保存数据错误[Exception]：' + e.message;
      Exit;
    end;
  end;

  y := GetTickCount;  //开始计时
  sMsg := '共计:' + IntToStr(m) + '数据导出完毕！【耗费:' + FloatToStr((y - x) / 1000) + '秒】';
  Result := True;
end;