You need to include a loop before your for I loop to write the field names to
the Data VarArray:
for C:= 0 to DS.Fieldcount-1 do Data[0,C]:= DS.Fields[C].FieldName;
The I in your for I / for J loop will then have to be +1:
for J := 0 to DS.FieldCount - 1 do
Data[I + 1, J] := DS.Fields[J].Value;
DS.Next;
Alternatively you could create a second, one-dimensional, VarArray with bounds
of [0, DS.FieldCount-1]. In this case when you come to write the Headers,
TopLeftCell will be ExcelApp.Range['A1'] and for the Data TopLeftCell will have
to be ExcelApp.Range['B1'];
Hopefully one or other will work.
Regards
Steve
From: [email protected] [mailto:[EMAIL PROTECTED] On Behalf Of
ron_tabada
Sent: 27 November 2007 04:50
To: [email protected]
Subject: [delphi-en] Zeos Dataset to excel: Field names missing
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;
***************************************************************************
This e-mail and any files transmitted with it are confidential. If you are not
the intended recipient, any reading, printing, storage, disclosure, copying or
any other action taken in respect of this e-mail is prohibited and may be
unlawful. If you are not the intended recipient, please notify the sender
immediately by using the reply function and then permanently delete what you
have received.
Content of emails received by this Trust will be subject to disclosure under
the Freedom of Information Act 2000, subject to the specified exemptions,
including the Data Protection Act 1998 and Caldicott Guardian principles.
This footnote also confirms that, unless otherwise stated, this email message
has been swept by Sophos Anti-virus for the presence of computer viruses.
***************************************************************************
