Hello Good day, I'm new in delphi. Can anyone help me. I'm exporting
data from zeos dataset to MS excel and done it successfully. But after
exporting it, the field names were missing. 

I have downloaded the code from
http://www.elists.org/pipermail/delphi-talk/2005-February/020132.html.
Unfortunately, the website is now under construction, I don't have the
chance of getting the author's email address.

Can anyone help me update the code below in such a way that it will
display the field names of the exported data. 


procedure TForm1.btnXferClick(Sender: TObject);
begin
  // if path has not been specified then output file will be in My
Documents folder

  ZqrySQL.Close;
  ZqrySQL.Open;

  DataSetToExcel(ZqrySQL,'report.xls');

end;

procedure DataSetToExcel(DS: TDataSet; const Filename: string);
var
  ExcelApp,
  WorkBook,
  WorkSheet,
  TopLeftCell: Variant;
  Data: Variant;
  Finger: string;
  I, J: Integer;
begin
// source:
http://www.elists.org/pipermail/delphi-talk/2005-February/020132.html
  //No operation for an empty dataset
  if DS.Bof and DS.Eof then Exit;

  //Create a variant array with all the specified data
  Data := VarArrayCreate([0, DS.RecordCount - 1, 0, DS.FieldCount - 1],
    varVariant);
  DS.DisableControls;
  try
    Finger := DS.Bookmark;
    try
      DS.First;
      for I := 0 to DS.RecordCount - 1 do
      begin
        for J := 0 to DS.FieldCount - 1 do
          Data[I, J] := DS.Fields[J].Value;
        DS.Next;
      end;
    finally
      DS.Bookmark := Finger;
    end;
  finally
    DS.EnableControls;
  end;
  ExcelApp := CreateOleObject('Excel.Application');
  WorkBook := ExcelApp.WorkBooks.Add;
  WorkSheet := WorkBook.WorkSheets.Add;

  //Put the data in the rectangle starting at cell "A1"
  TopLeftCell := ExcelApp.Range['A1'];
  ExcelApp.Range[TopLeftCell,
    TopLeftCell.Offset[DS.RecordCount - 1, DS.FieldCount - 1]].Value :=
Data;

  //Save the workbook
  Workbook.SaveAs(FileName);

  //Quit Excel (leave this one away to keep Excel on screen)
  ExcelApp.Quit;
end;


Reply via email to