uExportExcel.pas

Unit uExportExcel;

Interface

uses Classes, Dialogs, Db, ComObj, Forms, Controls, ComCtrls, SysUtils,
     SkinCtrls, SkinBoxCtrls, DynamicSkinForm, ABSDlgWait, System.Variants;
procedure ToExcel(dsData : TDataSource);
procedure ExportToExcel(dsData : TDataSource; ShowDialog : boolean; StatusBar : TspSkinStatusBar);

const
  VAR_MAXROWS = 2147483646;

Implementation

uses
   uFieldSelection;

procedure ExportToExcel(dsData : TDataSource; ShowDialog : boolean; StatusBar : TspSkinStatusBar);
var
  Ok : boolean;
  StopExportToExcel : boolean;
  MaxRows, HlpCnt : integer;
  fWait: TfrmWait;
const
  xlWBATWorksheet = -4167;

  procedure MakeSheet;
  var
    V : Variant;
    Cnt, FieldCnt, SheetColCnt,	SheetRowCnt : Integer;
    Sheet : Variant;
    HlpStr : string;
    BakDecimalSeparator : Char;
  begin
    if not VarIsEmpty(V) then VarClear(V);
    V := CreateOleObject( 'Excel.Application' );
    BakDecimalSeparator := FormatSettings.DecimalSeparator;
    FormatSettings.DecimalSeparator := '.';

    try
      V.Workbooks.Add( xlWBATWorksheet );
      V.WorkBooks[1].Worksheets[1].Name := 'AbsDb';
      Sheet := V.WorkBooks[1].Worksheets[ 'AbsDb' ];

      FieldCnt    := 0;
      SheetColCnt := 1;
      SheetRowCnt := 1;

      for Cnt := 0 to dsData.DataSet.Fields.Count -1  do
      begin
      	if (dsData.DataSet.Fields[Cnt].Visible) then
        begin
	  if (frmFieldSelection.FieldList.Checked[FieldCnt]) then
	     with dsData.DataSet.Fields[Cnt] do
             begin
	       Sheet.Cells[SheetRowCnt, SheetColCnt] := DisplayName;
	       Sheet.Cells[SheetRowCnt, SheetColCnt].Font.Bold := true;
	       if DisplayWidth <= 50 then
		 Sheet.Columns.Columns[ SheetColCnt ].ColumnWidth := DisplayWidth + 2
	       else
	         Sheet.Columns.Columns[ SheetColCnt ].ColumnWidth := 50;

	       Sheet.Columns.Columns[ SheetColCnt ].Font.Name := 'Arial';
	       Sheet.Columns.Columns[ SheetColCnt ].Font.Size := 10;

	       if (dsData.DataSet.Fields[Cnt].DataType in [ftFloat, ftDate, ftDateTime]) then
                 Sheet.Cells[SheetRowCnt, SheetColCnt].HorizontalAlignment := -4152;

	       Inc(SheetColCnt);
	     end;
	     Inc(FieldCnt);
	end;
      end;

      with dsData.DataSet do
      begin
      	dsData.DataSet.first;
       	while not(dsData.DataSet.eof) and (SheetRowCnt<=MaxRows) do
        begin
	  FieldCnt    := 0;
	  SheetColCnt := 1;
	  inc(SheetRowCnt);

	  for Cnt := 0 to FieldCount - 1 do
          begin
	    if dsData.DataSet.Fields[Cnt].Visible then
            begin
	      if (frmFieldSelection.FieldList.Checked[FieldCnt]) then
              begin
	      	if Fields[Cnt].DataType in [ ftDate, ftDateTime] then
	      	begin
	          if not(Fields[Cnt].IsNull) then
                    Sheet.Cells[SheetRowCnt, SheetColCnt] := FormatDateTime( 'mm-dd-yyyy',Fields[Cnt].asDateTime )
                  else
		    Sheet.Cells[SheetRowCnt, SheetColCnt] := '';
		end else
                begin
		  HlpStr := Fields[Cnt].asString;
                  if Fields[Cnt].DataType in [ ftString, ftMemo ] then
                     HlpStr := ''''+Hlpstr;
                  if (dsData.DataSet.Fields[Cnt].DataType = ftFloat) then
                     HlpStr := StringReplace(HlpStr,',','.',[rfIgnoreCase, rfReplaceAll]);

		  Sheet.Cells[SheetRowCnt, SheetColCnt] := HlpStr;
	        end;
		Inc(SheetColCnt);
	      end;
	      Inc(FieldCnt);
	    end;
	  end;

	  Next;

          fWait.pb.Position := fWait.pb.Position + 1;
				if (SheetRowCnt - 1) mod 100 = 0 then
          begin
            Application.ProcessMessages;
            if fWait.Terminated then break;
            if (StatusBar<>nil) then
            begin
	      StatusBar.Caption := ' Records exported : ' + IntToStr( SheetRowCnt - 1 );
            end;
          end;

	  if StopExportToExcel then break;
       	end;
      end;
      if (StatusBar<>nil) then
      begin
      	StatusBar.Caption := ' Successfully exported ' + IntToStr( SheetRowCnt - 1 )+' records to Excel';
      end;

    finally
      FormatSettings.DecimalSeparator := BakDecimalSeparator;
      V.Visible := true;
    end;
  end;

  begin
    if not (dsData.DataSet.Active) then dsData.DataSet.Open;

    Ok := true;
    Application.CreateForm(TfrmFieldSelection, frmFieldSelection);

    frmFieldSelection.ExportLimitCB.ItemIndex := 0;
    frmFieldSelection.FieldList.Items.Clear;

    for HlpCnt := 0 to dsData.DataSet.Fields.Count - 1 do
    begin
      if dsData.DataSet.Fields[HlpCnt].Visible then
      begin
      	frmFieldSelection.FieldList.Items.Add(dsData.DataSet.Fields[HlpCnt].DisplayName);
      	frmFieldSelection.FieldList.Checked[frmFieldSelection.FieldList.Items.Count-1] := true;
      end;
    end;

    if ShowDialog then
    begin
      Ok := (frmFieldSelection.ShowModal = mrOK);
    end;

    MaxRows := VAR_MAXROWS;
    if (trim(uppercase(frmFieldSelection.ExportLimitCB.Text))<>'ALL') then
    begin
      try
      	try
          MaxRows := StrToInt(trim(uppercase(frmFieldSelection.ExportLimitCB.Text)));
	except
	  ShowMessage('You specified an invalid number of records to export!');
          Ok := False;
      	end;
       finally
     end;
    end;

    StopExportToExcel := false;

    if not dsData.Dataset.Active then Exit;

    if ok then
    begin
      try
      	Screen.Cursor := crHourGlass;
      	dsData.DataSet.DisableControls;
        fWait:=TfrmWait.Create(nil);
        fWait.btnBgMode.Visible := False;
        fWait.pb.Max := dsData.DataSet.RecordCount;
        fWait.Show('Export to Excel');
        Application.ProcessMessages;
        fWait.ShowFormOnTimer(nil);
        MakeSheet;
      finally
       fWait.Close;
       fWait.Free;

       dsData.DataSet.EnableControls;
       dsData.DataSet.First;
       Screen.Cursor := crDefault;
      end;
  end;
  frmFieldSelection.Free;
end;

procedure ToExcel(dsData : TDataSource);
begin
  ExportToExcel(dsData, False, nil);
end;

end.