Export UniDBGrid To Excel Without OLE or Excel Application

[SMARAM]

Hi,

 

As the title says, I converted a library that Mike Heydon made to export a DataSet to old format Excel file (xls) without OLE or Excel installed.

This library now converts an UniDBGrid to Excel.

 

Sample of usage. 

//  Add uses UExportExcel

procedure TMainForm.UniButton1Click(Sender: TObject);
var url, filename, reportname : String;
    exportExcel: TDataSetToExcel;
    i: integer;
begin
	reportname := 'ExcelReport';
	url := UniServerModule.LocalCacheURL+name+'.xls';
	filename := UniServerModule.NewCacheFileUrl(false, 'xls', reportname, '', url);

	exportExcel := TDataSetToExcel.Create(filename);
  exportExcel.Grid := UniDBGrid1;
  exportExcel.WriteFile;
  FreeAndNil(exportExcel);
  UniSession.SendFile(filename, reportname+'.xls');
end;

Hope it helps everyone. 

UExportExcel.zip

[mhmda]

We use TMS FlexCel https://www.tmssoftware.com/site/flexcel.asp to do that and it works great :-)

[Bresler]

Hi Smaram, thanks for share!

[Beginner]

Unidbgrid with summary total how can i export to excel?

[SMARAM]

For people who is having problems with download the zip file.

UExportExcel.pas

 

//=============================================================================
// TDataSet to Excel without OLE or Excel required
// Mike Heydon Dec 2002

// Adapted to Unigui with TUniDBGrid
// Mauricio Naozuka - 26/04/2018 - naozuka@gmail.com
//=============================================================================

unit UExportExcel;

//  Example
//
//  Add uses UExportExcel
//
//procedure TMainForm.UniButton1Click(Sender: TObject);
//var url, filename, reportname : String;
//    exportExcel: TDataSetToExcel;
//    i: integer;
//begin
//	reportname := 'ExcelReport';
//	url := UniServerModule.LocalCacheURL+name+'.xls';
//	filename := UniServerModule.NewCacheFileUrl(false, 'xls', reportname, '', url);
//
//	exportExcel := TDataSetToExcel.Create;
//  exportExcel.WriteFile(filename, UniDBGrid1);
//  FreeAndNil(exportExcel);
//  UniSession.SendFile(filename, reportname+'.xls');
//end;

interface

uses Windows, SysUtils, DB, Math, uniBasicGrid, uniDBGrid;

type
  // TDataSetToExcel
  TDataSetToExcel = class(TObject)
  protected
    procedure WriteToken(AToken: word; ALength: word);
    procedure WriteFont(const AFontName: Ansistring; AFontHeight,
      AAttribute: word);
    procedure WriteFormat(const AFormatStr: Ansistring);
  private
    FRow: word;
    FFieldCount: integer;
    FDataFile: file;
    FFileName: string;
  public
    constructor Create;
    function WriteFile(const AFileName: string; const AGrid: TUniDBGrid): boolean;
  end;

//-----------------------------------------------------------------------------
implementation

const
  // XL Tokens
  XL_DIM = $00;
  XL_BOF = $09;
  XL_EOF = $0A;
  XL_DOCUMENT = $10;
  XL_FORMAT = $1E;
  XL_COLWIDTH = $24;
  XL_FONT = $31;

  // XL Cell Types
  XL_INTEGER = $02;
  XL_DOUBLE = $03;
  XL_STRING = $04;

  // XL Cell Formats
  XL_INTFORMAT = $81;
  XL_DBLFORMAT = $82;
  XL_XDTFORMAT = $83;
  XL_DTEFORMAT = $84;
  XL_TMEFORMAT = $85;
  XL_HEADBOLD = $40;
  XL_HEADSHADE = $F8;

  // ========================
  // Create the class
  // ========================

constructor TDataSetToExcel.Create;
begin
  FFieldCount := 0;
end;

// ====================================
// Write a Token Descripton Header
// ====================================

procedure TDataSetToExcel.WriteToken(AToken: word; ALength: word);
var
  aTOKBuffer: array[0..1] of word;
begin
  aTOKBuffer[0] := AToken;
  aTOKBuffer[1] := ALength;
  Blockwrite(FDataFile, aTOKBuffer, SizeOf(aTOKBuffer));
end;

// ====================================
// Write the font information
// ====================================

procedure TDataSetToExcel.WriteFont(const AFontName: ansistring;
  AFontHeight, AAttribute: word);
var
  iLen: byte;
begin
  AFontHeight := AFontHeight * 20;
  WriteToken(XL_FONT, 5 + length(AFontName));
  BlockWrite(FDataFile, AFontHeight, 2);
  BlockWrite(FDataFile, AAttribute, 2);
  iLen := length(AFontName);
  BlockWrite(FDataFile, iLen, 1);
  BlockWrite(FDataFile, AFontName[1], iLen);
end;

// ====================================
// Write the format information
// ====================================

procedure TDataSetToExcel.WriteFormat(const AFormatStr: ansistring);
var
  iLen: byte;
begin
  WriteToken(XL_FORMAT, 1 + length(AFormatStr));
  iLen := length(AFormatStr);
  BlockWrite(FDataFile, iLen, 1);
  BlockWrite(FDataFile, AFormatStr[1], iLen);
end;

// ====================================
// Write the XL file from data set
// ====================================

function TDataSetToExcel.WriteFile(const AFilename:String; const AGrid: TUniDBGrid): boolean;
var
  bRetvar: boolean;
  aDOCBuffer: array[0..1] of word;
  aDIMBuffer: array[0..3] of word;
  aAttributes: array[0..2] of byte;
  i: integer;
  iColNum,
  iDataLen: byte;
  sStrData: string;
  fDblData: double;
  wWidth: word;
  sStrBytes: TBytes;
begin
  if not Assigned(AGrid) then
    raise Exception.Create('There is no Grid is vinculated.');

  if not Assigned(AGrid.DataSource) then
    raise Exception.Create('There is no DataSource is vinculated to Grid ' + AGrid.Name);

  if not Assigned(AGrid.DataSource.DataSet) then
    raise Exception.Create('There is no DataSet is vinculated to DataSource ' + AGrid.DataSource.Name);

  bRetvar := true;
  FRow := 0;
  FillChar(aAttributes, SizeOf(aAttributes), 0);
  FFileName := ChangeFileExt(AFilename, '.xls');
  AssignFile(FDataFile, FFileName);

  try
    Rewrite(FDataFile, 1);
    // Beginning of File
    WriteToken(XL_BOF, 4);
    aDOCBuffer[0] := 0;
    aDOCBuffer[1] := XL_DOCUMENT;
    Blockwrite(FDataFile, aDOCBuffer, SizeOf(aDOCBuffer));

    // Font Table
    WriteFont('Arial', 10, 0);
    WriteFont('Arial', 10, 1);
    //WriteFont('Courier New', 11, 0);

    // Column widths
    iColNum := 0;
    for i := 0 to AGrid.Columns.Count-1 do
    begin
      if not AGrid.Columns[i].Visible then
        continue;

      if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DisplayWidth + 1 >
         Length(AGrid.Columns[i].Title.Caption) then
      begin
        wWidth := (AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DisplayWidth + 1) * 256;
      end
      else
      begin
        wWidth := (Length(AGrid.Columns[i].Title.Caption) + 1) * 256;
      end;

      // Limitar o tamanho da coluna
      if wWidth > 80*256 then
        wWidth := 80*256;

//      if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType = ftDateTime then
//        inc(wWidth, 100);
//      if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType = ftDate then
//        inc(wWidth, 1050);
//      if AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType = ftTime then
//        inc(wWidth, 100);

      WriteToken(XL_COLWIDTH, 4);

      BlockWrite(FDataFile, iColNum, 1);
      BlockWrite(FDataFile, iColNum, 1);
      BlockWrite(FDataFile, wWidth, 2);
      Inc(iColNum);
    end;

    FFieldCount := iColNum;

    // Column Formats
    WriteFormat('Geral');
    WriteFormat('0');
    WriteFormat('#.##0,0000');
    WriteFormat('dd/mm/aaaa hh:mm:ss');
    WriteFormat('dd/mm/aaaa');
    WriteFormat('hh:mm:ss');

    // Dimensions
    WriteToken(XL_DIM, 8);
    aDIMBuffer[0] := 0;
    aDIMBuffer[1] := Min(AGrid.DataSource.DataSet.RecordCount, $FFFF);
    aDIMBuffer[2] := 0;
    aDIMBuffer[3] := Min(FFieldCount - 1, $FFFF);
    Blockwrite(FDataFile, aDIMBuffer, SizeOf(aDIMBuffer));

    // Column Headers
    iColNum := 0;
    for i := 0 to AGrid.Columns.Count-1 do
    begin
      if not AGrid.Columns[i].Visible then
        continue;

      //      sStrData := FDataSet.Fields[i].DisplayName;
      sStrBytes := TEncoding.ANSI.GetBytes(AGrid.Columns[i].Title.Caption);
      iDataLen := length(sStrBytes);
      WriteToken(XL_STRING, iDataLen + 8);
      WriteToken(FRow, iColNum);
      aAttributes[1] := XL_HEADBOLD;
      //aAttributes[2] := XL_HEADSHADE;
      BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
      BlockWrite(FDataFile, iDataLen, SizeOf(iDataLen));
      if iDataLen > 0 then
        BlockWrite(FDataFile, sStrBytes[0], iDataLen);
      aAttributes[2] := 0;
      Inc(iColNum);
    end;

    try
      AGrid.DataSource.DataSet.DisableControls;
      AGrid.DataSource.DataSet.First;

      // Data Rows
      while not AGrid.DataSource.DataSet.Eof do
      begin
        inc(FRow);
        iColNum := 0;

        for i := 0 to AGrid.Columns.Count-1 do
        begin
          if not AGrid.Columns[i].Visible then
            continue;

          case AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).DataType of
              ftBoolean,
              ftWideString,
              ftFixedChar,
              ftString:
              begin
                try
                  //              sStrData := FDataSet.Fields[i].AsString;

                  sStrBytes:=TEncoding.ANSI.GetBytes(AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsString);
                  iDataLen := length(sStrBytes);
                  WriteToken(XL_STRING, iDataLen + 8);
                  WriteToken(FRow, iColNum);
                  aAttributes[1] := 0;
                  BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                  BlockWrite(FDataFile, iDataLen, SizeOf(iDataLen));
                  if iDataLen > 0 then
                    BlockWrite(FDataFile, sStrBytes[0], iDataLen);
                except on E: Exception do
                  //ShowMessage(E.Message);
                  raise Exception.Create('Erro Converter: ' + E.Message);
                end;
              end;

              ftAutoInc,
              ftSmallInt,
              ftInteger,
              ftWord,
              ftLargeInt:
              begin
                try
                fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                iDataLen := SizeOf(fDblData);
                WriteToken(XL_DOUBLE, 15);
                WriteToken(FRow, iColNum);
                aAttributes[1] := XL_INTFORMAT;
                BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                BlockWrite(FDataFile, fDblData, iDatalen);
                except on E: Exception do
                  //ShowMessage(E.Message);
                  raise Exception.Create('Erro Converter Inteiro: ' + E.Message);
                end;
              end;

              ftFloat,
              ftCurrency,
              ftBcd,
              ftFMTBcd:
              begin
                try
                fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                iDataLen := SizeOf(fDblData);
                WriteToken(XL_DOUBLE, 15);
                WriteToken(FRow, iColNum);
                aAttributes[1] := XL_DBLFORMAT;
                BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                BlockWrite(FDataFile, fDblData, iDatalen);
                except on E: Exception do
                  //ShowMessage(E.Message);
                  raise Exception.Create('Erro Converter Float: ' + E.Message);
                end;
              end;

            ftDateTime:
              begin
                try
                  if not AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).IsNull then
                  begin
                    fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                    iDataLen := SizeOf(fDblData);
                    WriteToken(XL_DOUBLE, 15);
                    WriteToken(FRow, iColNum);
                    aAttributes[1] := XL_XDTFORMAT;
                    BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                    BlockWrite(FDataFile, fDblData, iDatalen);
                  end;
                except on E: Exception do
                  //ShowMessage(E.Message);
                  raise Exception.Create('Erro Converter DateTime: ' + E.Message);
                end;
              end;

            ftDate:
              begin
                try
                  if not AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).IsNull then
                  begin
                    fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                    iDataLen := SizeOf(fDblData);
                    WriteToken(XL_DOUBLE, 15);
                    WriteToken(FRow, iColNum);
                    aAttributes[1] := XL_DTEFORMAT;
                    BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                    BlockWrite(FDataFile, fDblData, iDatalen);
                  end;
                except on E: Exception do
                  //ShowMessage(E.Message);
                  raise Exception.Create('Erro Converter Date: ' + E.Message);
                end;
              end;

            ftTime:
              begin
                try
                  if not AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).IsNull then
                  begin
                    fDblData := AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).AsFloat;
                    iDataLen := SizeOf(fDblData);
                    WriteToken(XL_DOUBLE, 15);
                    WriteToken(FRow, iColNum);
                    aAttributes[1] := XL_TMEFORMAT;
                    BlockWrite(FDataFile, aAttributes, SizeOf(aAttributes));
                    BlockWrite(FDataFile, fDblData, iDatalen);
                  end;
                except on E: Exception do
                  //ShowMessage(E.Message);
                  raise Exception.Create('Erro Converter Time: ' + E.Message);
                end;
              end;

            ftMemo:
              begin
                // Does not print memo
              end;

          else raise Exception.Create('Tipo [' + AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).ClassName + '] do campo [' +
                                      AGrid.DataSource.DataSet.FieldByName(AGrid.Columns[i].FieldName).FieldName + '] não foi tratado.');

          end;

          Inc(iColNum);
        end; // end of for

        AGrid.DataSource.DataSet.Next;
      end; // end of while

    finally
      AGrid.DataSource.DataSet.EnableControls;
      AGrid.DataSource.DataSet.First;
    end;

    // End of File
    WriteToken(XL_EOF, 0);
    CloseFile(FDataFile);
  except
    bRetvar := false;
  end;

  Result := bRetvar;
end;

end.

 

[deljavan]

Hi
I used your file in the program
But it has errors when compiling the program
I think I've done all the steps properly

[SMARAM]

On 3/26/2020 at 4:50 AM, deljavan said:

Hi
I used your file in the program
But it has errors when compiling the program
I think I've done all the steps properly

Hi, your problem is linking the file into your project.

1) Did you put the UExportExcel into uses of frmcontact?

2) Did you add UExportExcel into your project?

[deljavan]

Problem resolved
But the output is unclear

help please

ContactReportExcel.xls

[SMARAM]

On 3/30/2020 at 6:31 PM, deljavan said:

Problem resolved
But the output is unclear

help please

ContactReportExcel.xls

Which language are you exporting? Is it not ansi characters?

[deljavan]

  On 3/31/2020 at 2:01 AM, deljavan said:

Problem resolved
But the output is unclear

help please

ContactReportExcel.xls

Which language are you exporting? Is it not ansi characters?

 

persian  (فارسی - farsi) or arabic

[Eraldo Trevisan]

Hi everyone,

following a similar logic to the export library, would anyone know how to import the information from an excel file?

 

 

Thanks for any help

[donlego]

@SMARAM

how to add header title on 1st / 2nd row

[Simoring]

i have a problem as shown in the picture. Can you help me?

[Sherzod]

46 minutes ago, Simoring said:

i have a problem as shown in the picture. Can you help me?

Hello,

Can you please specify first, which edition and build of UniGUI are you using?

[Simoring]

51 minutes ago, Sherzod said:

Hello,

Can you please specify first, which edition and build of UniGUI are you using?

Delphi 10.3 edition.

[Sherzod]

Not Delphi, UniGUI. 

[Simoring]

unigui 1.90.0 build 1530

[Sherzod]

29 minutes ago, Simoring said:

unigui 1.90.0 build 1530

Sorry for clarifying several times. If you are not using the trial version, please adjust your forum email address first: