EXPORTER UN DATASET VERS EXCEL VIA XML

procedure TfrmCBSSReport.Dataset2XLSXML(DataSet:TDataSet; sFile:String);
Const
   sHeadXML       = '<?xml version="1.0" encoding="UTF-8"?>';
   sWorkBookBegin = '<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"'+
                    ' xmlns:x="urn:schemas-microsoft-com:office:excel"'+
                    ' xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"'+
                    ' xmlns:html="http://www.w3.org/TR/REC-html40">';
   sEndWorkBook   = '</Workbook>';
   sEndWorkSheet  = ' </Worksheet>';
   sTable         = '  <Table>';
   sEndTable      = '  </Table>';
   sRow           = '   <Row>';
   sEndRow        = '   </Row>';
   sCell          = '    <Cell>';
   sEndCell       = '</Cell>';

Var
  sXlsXml:String;
  iColumn:Integer;
  reXLSXML:TStringList;
  ftXLSXML:TextFile;


begin
 //log file
 AssignFile(ftXLSXML,sFile);
 {$I-}
 Reset(ftXLSXML);
 {$I+}
 if IOResult <> 0 then
 begin
   Rewrite(ftXLSXML);
 end;

 Append(ftXLSXML);
 Writeln(ftXLSXML,sHeadXML);
 Flush(ftXLSXML);

 Append(ftXLSXML);
 Writeln(ftXLSXML,sWorkBookBegin);
 Flush(ftXLSXML);

 Append(ftXLSXML);
 Writeln(ftXLSXML,' <Worksheet ss:Name="Table1">');
 Flush(ftXLSXML);

 //Add columns
 For iColumn:=0 to DataSet.FieldCount -1 do
 begin
   sXlsXml := sXlsXml + '   <Column ss:Index="'+IntToStr(iColumn+1)+'" ss:AutoFitWidth="0" ss:Width="110"/>';
 end;
 Append(ftXLSXML);
 Writeln(ftXLSXML,sXlsXml+sRow);
 Flush(ftXLSXML);


 //Add Cells definitions (Titles)
 For iColumn:=0 to DataSet.FieldCount -1 do
 begin
   Append(ftXLSXML);
   Writeln(ftXLSXML,sCell+'<Data ss:Type="String">'+DataSet.Fields[iColumn].FieldName+'</Data>'+sEndCell);
   Flush(ftXLSXML);
 end;
 Append(ftXLSXML);
 Writeln(ftXLSXML,sEndRow);
 Flush(ftXLSXML);

 While Not DataSet.Eof do
 begin
   Append(ftXLSXML);
   Writeln(ftXLSXML,sRow);
   Flush(ftXLSXML);

   //Add each value by field
   For iColumn:=0 to DataSet.FieldCount -1 do
   begin               
     Append(ftXLSXML);
     Writeln(ftXLSXML,sCell+'<Data ss:Type="String">'+DataSet.FieldByName(DataSet.Fields[iColumn].FieldName).AsString +'</Data>'+sEndCell);
     Flush(ftXLSXML);
   end;
   Append(ftXLSXML);
   Writeln(ftXLSXML,sEndRow);
   Flush(ftXLSXML);

   DataSet.Next;
 end;

 Append(ftXLSXML);
 Writeln(ftXLSXML,sEndTable);
 Flush(ftXLSXML);

 Append(ftXLSXML);
 Writeln(ftXLSXML,sEndWorkSheet);
 Flush(ftXLSXML);

 Append(ftXLSXML);
 Writeln(ftXLSXML,sEndWorkbook);
 Flush(ftXLSXML);

 CloseFile(ftXLSXML);


{ another way to do
  reXLSXML := TStringList.Create;
  reXLSXML.PlainText := True;

  reXLSXML.Add(sHeadXML);
  reXLSXML.Add(sWorkBookBegin);
  reXLSXML.Add(' <Worksheet ss:Name="Table1">');
  reXLSXML.Add(sTable);

  //Add columns
  For iColumn:=0 to DataSet.FieldCount -1 do
  begin
    sXlsXml := sXlsXml + '   <Column ss:Index="'+IntToStr(iColumn+1)+'" ss:AutoFitWidth="0" ss:Width="110"/>';
  end;
  reXLSXML.Add(sXlsXml+sRow);

  //Add Cells definitions (Titles)
  For iColumn:=0 to DataSet.FieldCount -1 do
  begin
    reXLSXML.Add(sCell+'<Data ss:Type="String">'+DataSet.Fields[iColumn].FieldName+'</Data>'+sEndCell);
  end;
  reXLSXML.Add(sEndRow);

  While Not DataSet.Eof do
  begin
    reXLSXML.Add(sRow);
    //Add each value by field
    For iColumn:=0 to DataSet.FieldCount -1 do
    begin               //'+getDataType(DataSet.Fields[iColumn].DataType)+'
      reXLSXML.Add(sCell+'<Data ss:Type="String">'+DataSet.FieldByName(DataSet.Fields[iColumn].FieldName).AsString +'</Data>'+sEndCell);
    end;
    reXLSXML.Add(sEndRow);
    DataSet.Next;
  end;

  reXLSXML.Add(sEndTable);
  reXLSXML.Add(sEndWorkSheet);
  reXLSXML.Add(sEndWorkbook);

  reXLSXML.SaveToFile(sFile);
  reXLSXML.Free;
  }
end;

procedure TfrmCBSSReport.SpeedButton1Click(Sender: TObject);
begin
   Dataset2XLSXML(query1,'c:\test.xls');
end;