[分享]将dataset导出EXCEL的function

Question

procedure TFrmMain.WriteExcel(AdsData: TADODataSet; sName, Title: string); 
var 
ExcelApplication1: TExcelApplication; 
ExcelWorksheet1: TExcelWorksheet; 
ExcelWorkbook1: TExcelWorkbook; 
i, j: integer; 
filename: string; 
begin 
filename := concat(extractfilepath(application.exename), sName, ’.xls’); 
try 
ExcelApplication1 := TExcelApplication.Create(Application); 
ExcelWorksheet1 := TExcelWorksheet.Create(Application); 
ExcelWorkbook1 := TExcelWorkbook.Create(Application); 
ExcelApplication1.Connect; 
except 
Application.Messagebox(’Excel 没有安装!’, ’Hello’, MB_ICONERROR + mb_Ok); 
Abort; 
end; 
try 
ExcelApplication1.Workbooks.Add(EmptyParam, 0); 
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]); 
ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet); 
AdsData.First; 
for j := 0 to AdsData.Fields.Count - 1 do 
begin 
ExcelWorksheet1.Cells.item[3, j + 1] := AdsData.Fields[j].DisplayLabel; 
ExcelWorksheet1.Cells.item[3, j + 1].font.size := ’10’; 
end; 
for i := 4 to AdsData.RecordCount + 3 do 
begin 
for j := 0 to AdsData.Fields.Count - 1 do 
begin 
ExcelWorksheet1.Cells.item[i, j + 1] := 
AdsData.Fields[j].Asstring; 
ExcelWorksheet1.Cells.item[i, j + 1].font.size := ’10’; 
end; 
AdsData.Next; 
end; 
ExcelWorksheet1.Columns.AutoFit; 
ExcelWorksheet1.Cells.item[1, 2] := Title; 
ExcelWorksheet1.Cells.Item[1, 2].font.size := ’14’; 
ExcelWorksheet1.SaveAs(filename); 
Application.Messagebox(pchar(’数据成功导出’ + filename), ’Hello’, 
mb_Ok); 
finally 
ExcelApplication1.Disconnect; 
ExcelApplication1.Quit; 
ExcelApplication1.Free; 
ExcelWorksheet1.Free; 
ExcelWorkbook1.Free; 
end; 
end;