Delphi 数据导出到Excel

好多办公软件特别是财务软件，都需要配备把数据导出到Excel，下面就来介绍两种数据导出方法

1.ADODB导出查询结果（此方法需要安装Excel）

2.二维表数据导出（根据Excel文件结构生成二进制文件流，不需要安装Excel）

3.如果涉及到复杂表头的（例如合并字段等），未做研究，下面也没介绍相关资料，请止步。

 

第一种，ADODB导出查询结果（此方法需要安装Excel）

//uses DB, ADODB, ComObj, ComCtrls,  excel2000,  StdCtrls, adoint,
var
  xlApp, xlBook, xlSheet, xlQuery: Variant;
  adoConnection, adoRecordset: Variant;
begin
  adoConnection := CreateOleobject('ADODB.Connection');
  adoRecordset := CreateOleobject('ADODB.Recordset');
  adoConnection.Open(
    'Provider=MSDASQL.1;Password=000000;Persist Security Info=True;User ID=my_username;Data Source=tax_ora;Extended Properties="DSN=tax_ora;UID=net_user;PWD=000000;DBQ=TAX_ORA101;DBA=W;APA=T;EXC=F;FEN=T;QTO=T;' + 'FRC=10;FDL=10;LOB=T;RST=T;BTD=F;BNF=F;BAM=IfAllSuccessful;NUM=NLS;DPM=F;MTS=T;MDI=F;CSR=F;FWC=F;FBS=64000;TLO=O;MLD=0;ODA=F;"');
  adoRecordset.CursorLocation := adUseClient;
  adoRecordset.Open('select * from userinfo where rownum<100', adoConnection,
    1, 3);
  try
    xlApp := CreateOleobject('Excel.Application');
    xlBook := xlApp.Workbooks.Add;
    xlSheet := xlBook.WorkSheets['sheet1'];

    // 设置这一列为 文本列 ，让 "00123" 正确显示，而不是自动转换为"123"
    xlSheet.Columns['C:C'].NumberFormatLocal := '@';

    xlApp.Visible := True;

    // 把查询结果导入EXCEL数据
    xlQuery := xlSheet.QueryTables.Add(adoRecordset, xlSheet.Range['A1']);
    // 关键是这一句
    xlQuery.FieldNames := True;
    xlQuery.RowNumbers := False;
    xlQuery.FillAdjacentFormulas := False;
    xlQuery.PreserveFormatting := True;
    xlQuery.RefreshOnFileOpen := False;
    xlQuery.BackgroundQuery := True;
    // xlQuery.RefreshStyle := xlInsertDeleteCells;
    xlQuery.SavePassword := True;
    xlQuery.SaveData := True;
    xlQuery.AdjustColumnWidth := True;
    xlQuery.RefreshPeriod := 0;
    xlQuery.PreserveColumnInfo := True;
    xlQuery.FieldNames := True;
    xlQuery.Refresh;

    xlBook.SaveAs('c:\fromD.xls', xlNormal, '', '', False, False);

  finally
    if not VarIsEmpty(xlApp) then
    begin
      xlApp.DisplayAlerts := False;
      xlApp.ScreenUpdating := True;
      xlApp.Quit;
    end;
  end;
end;

第二种，不需要安装Excel是它的绝对优势，而且不限于数据库表查询，你还可以导出listview，甚至你自定义的record数据。

var
  arXlsBegin: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
  arXlsEnd: array[0..1] of Word = ($0A, 00);
  arXlsString: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
  arXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
  arXlsInteger: array[0..4] of Word = ($27E, 10, 0, 0, 0);
  arXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);

Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean);
//.....
implementation
//.....
Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean);
const
  coltitle: array [0 .. 3] of string = ('第一行', '第二行', '第三行', '第四行');

type
  TArrContent = array [0 .. 3, 0 .. 3] of string;

var
  i, j: Integer;
  Col, row: Word;
  ABookMark: TBookMark;
  aFileStream: TFileStream;
  A: TArrContent;
  // ......
  procedure incColRow; // 增加行列号
  begin
    // if Col = aDataSet.FieldCount - 1 then
    if Col = Length(coltitle) - 1 then
    begin
      Inc(row);
      Col := 0;
    end
    else
      Inc(Col);
  end;

  procedure WriteStringCell(AValue: AnsiString); // 写字符串数据, 在Delphi7之后的版本，string使用Unicode编码的，要AnsiString，不然会出现中文乱码
  var
    L: Word;
  begin
    L := Length(AValue);
    arXlsString[1] := 8 + L;
    arXlsString[2] := row;
    arXlsString[3] := Col;
    arXlsString[5] := L;
    aFileStream.WriteBuffer(arXlsString, SizeOf(arXlsString));
    aFileStream.WriteBuffer(AValue[1], L);
    incColRow;
  end;

  procedure WriteIntegerCell(AValue: Integer); // 写整数
  var
    V: Integer;
  begin
    arXlsInteger[2] := row;
    arXlsInteger[3] := Col;
    aFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));
    V := (AValue shl 2) or 2;
    aFileStream.WriteBuffer(V, 4);
    incColRow;
  end;

  procedure WriteFloatCell(AValue: double); // 写浮点数
  begin
    arXlsNumber[2] := row;
    arXlsNumber[3] := Col;
    aFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));
    aFileStream.WriteBuffer(AValue, 8);
    incColRow;
  end;

// ......
begin
  for i := Low(A) to High(A) do
  begin
    for j := Low(A[i]) to High(A[i]) do
      A[i, j] := IntToStr(i) + ',' + IntToStr(j) + ' ';
  end;
  if FileExists(FileName) then
    DeleteFile(FileName); // 文件存在，先删除
  aFileStream := TFileStream.Create(FileName, fmCreate);
  Try // 写文件头
    aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin)); // 写列头
    Col := 0;
    row := 0;
    if bWriteTitle then
    begin
      for i := 0 to Length(coltitle) - 1 do
        WriteStringCell(coltitle[i]);
    end;

    for i := Low(A) to High(A) do
    begin
      for J := Low(A) to High(A) do
      begin
        WriteStringCell(A[i, j]);
        //此处可以判断A[i, j]的数据类型，分别调用
        //WriteIntegerCell()
        //WriteFloatCell()
      end;
    end;
    // 写文件尾
    aFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));
  Finally
    aFileStream.Free;
  end;
end;

ExportExcelFile('d:\数据2.xls', True);

调用结果

 

三、有一种直接把TStringList保存为Excel的，也可以，很方便，但是遇到数值字段的时候会变成科学记数法形式，所以我没有使用这个方法。

var
  s: TStringList;
  str: string;
  i, j: Integer;
begin
  str := '';
  for i := 0 to RzListView1.Columns.Count - 1 do
    str := str + RzListView1.Columns[i].DisplayName + Char(9);
  str := str + #13;

  for i := 0 to RzListView1.Items.Count - 1 do
  begin
    str := str + RzListView1.Items[i].Caption + Char(9);
    for j := 0 to RzListView1.Items[i].SubItems.Count - 1 do
    begin
      str := str + RzListView1.Items[i].SubItems[j] + Char(9);
    end;

    str := str + #13;
  end;
  s := TStringList.Create;
  s.Add(str);
  s.SaveToFile('c:\temp.xls'); // 保存到c:\temp.xls
  s.Free;
end;

此方法不做详细解释

 

此文章参考资料来自：Delphi 导出数据至Excel的7种方法