TmsFlexcelExports

unit TmsFlexcelExports;

interface

Uses
  Windows, System.SysUtils, System.Classes, VCL.FlexCel.Core,
  FlexCel.XlsAdapter, Data.DB;

procedure DataSetToXLS(fName: string; DataSet: TDataSet;
  WorkSheetCount: Integer = 1; ActiveSheet: Integer = 1);
procedure DataSetToCSV(fName: string; DataSet: TDataSet;
  WorkSheetCount: Integer = 1; ActiveSheet: Integer = 1);

implementation

procedure DataSetToXLS(fName: string; DataSet: TDataSet;
  WorkSheetCount: Integer = 1; ActiveSheet: Integer = 1);
var
  ioldrecno, icol, irow: Integer;
  fmt: TFlxFormat;
  fmtDateTime: Integer;
  XLSX: TExcelFile;
begin
  XLSX := TXlsFile.Create(True);
  try
    ioldrecno := DataSet.RecNo;
    if SameText(ExtractFileExt(fName), '.XLSX') then
      XLSX.SupportsXlsx := True;
    XLSX.NewFile(WorkSheetCount, TExcelFileFormat(5));
    // 4 = V2016 3 = V2013  2 = v2010, 1 = v2007, 0 = v2003
    XLSX.ActiveSheet := ActiveSheet;
    fmt := XLSX.GetDefaultFormat;
    fmt.Format := 'yyyy-mm-dd HH:MM:SS AM/PM';
    fmtDateTime := XLSX.AddFormat(fmt);
    irow := 1;
    for icol := 0 to DataSet.FieldCount - 1 do
    begin
      XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].DisplayName);
    end;
    inc(irow);
    DataSet.First;
    while Not DataSet.EOF do
    begin
      for icol := 0 to DataSet.FieldCount - 1 do
      begin
        case DataSet.Fields[icol].DataType of
          ftUnknown, ftString, ftBoolean, ftBCD, ftBytes, ftVarBytes, ftAutoInc,
            ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle,
            ftTypedBinary, ftCursor, ftFixedChar, ftWideString, ftADT, ftArray,
            ftReference, ftDataSet, ftOraBlob, ftOraClob, ftVariant,
            ftInterface, ftIDispatch, ftGuid, ftFMTBcd, ftFixedWideChar,
            ftWideMemo, ftOraInterval, ftConnection, ftParams, ftStream,
            ftTimeStampOffset, ftObject:
            begin
              XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].AsString);
            end;
          ftSmallint, ftInteger, ftWord, ftLargeint, ftLongWord, ftShortint,
            ftByte, ftSingle:
            begin
              XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].AsInteger);
            end;
          ftDate, ftTime, ftDateTime, ftOraTimeStamp, ftTimeStamp:
            begin
              XLSX.SetCellValue(irow, icol + 1,
                DataSet.Fields[icol].AsDateTime);
              XLSX.SetCellFormat(irow, icol + 1, fmtDateTime);
            end;
          ftExtended, ftFloat, ftCurrency:
            begin
              XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].AsFloat);
            end;
        end;
      end;
      inc(irow);
      DataSet.Next;
    end;
    DataSet.RecNo := ioldrecno;
    XLSX.Save(fName);
  finally
    XLSX.Free;
  end;

end;

procedure DataSetToCSV(fName: string; DataSet: TDataSet;
  WorkSheetCount: Integer = 1; ActiveSheet: Integer = 1);
var
  ioldrecno, icol, irow: Integer;
  fmt: TFlxFormat;
  fmtDateTime: Integer;
  XLSX: TExcelFile;
begin
  XLSX := TXlsFile.Create(True);
  try
    ioldrecno := DataSet.RecNo;
    if SameText(ExtractFileExt(fName), '.XLSX') then
      XLSX.SupportsXlsx := True;
    XLSX.NewFile(WorkSheetCount, TExcelFileFormat(5));
    // 4 = V2016 3 = V2013  2 = v2010, 1 = v2007, 0 = v2003
    XLSX.ActiveSheet := ActiveSheet;
    fmt := XLSX.GetDefaultFormat;
    fmt.Format := 'yyyy-mm-dd HH:MM:SS AM/PM';
    fmtDateTime := XLSX.AddFormat(fmt);
    irow := 1;
    for icol := 0 to DataSet.FieldCount - 1 do
    begin
      XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].DisplayName);
    end;
    inc(irow);
    DataSet.First;
    while Not DataSet.EOF do
    begin
      for icol := 0 to DataSet.FieldCount - 1 do
      begin
        case DataSet.Fields[icol].DataType of
          ftUnknown, ftString, ftBoolean, ftBCD, ftBytes, ftVarBytes, ftAutoInc,
            ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle,
            ftTypedBinary, ftCursor, ftFixedChar, ftWideString, ftADT, ftArray,
            ftReference, ftDataSet, ftOraBlob, ftOraClob, ftVariant,
            ftInterface, ftIDispatch, ftGuid, ftFMTBcd, ftFixedWideChar,
            ftWideMemo, ftOraInterval, ftConnection, ftParams, ftStream,
            ftTimeStampOffset, ftObject:
            begin
              XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].AsString);
            end;
          ftSmallint, ftInteger, ftWord, ftLargeint, ftLongWord, ftShortint,
            ftByte, ftSingle:
            begin
              XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].AsInteger);
            end;
          ftDate, ftTime, ftDateTime, ftOraTimeStamp, ftTimeStamp:
            begin
              XLSX.SetCellValue(irow, icol + 1,
                DataSet.Fields[icol].AsDateTime);
              XLSX.SetCellFormat(irow, icol + 1, fmtDateTime);
            end;
          ftExtended, ftFloat, ftCurrency:
            begin
              XLSX.SetCellValue(irow, icol + 1, DataSet.Fields[icol].AsFloat);
            end;
        end;
      end;
      inc(irow);
      DataSet.Next;
    end;
    DataSet.RecNo := ioldrecno;
    XLSX.Save(fName, TFileFormats.Text, ',', TEncoding.Unicode);
    // XLSX.Save(fName);
  finally
    XLSX.Free;
  end;

end;

end.