Delphi 快速將資料集匯出 Excel（檔案流方式）

問題背景

資料庫應用常需將同類型資料匯出 Excel 進一步加工。常見 OLE 自動化、ADO 等技術速度極慢，資料超過千筆即難以忍受。剪貼板雖快但佔記憶體大，且 Excel Paste 需鎖定輸入，不便使用。

解決方案：檔案流直接寫入 Excel 二進位格式

使用 TFileStream 直接寫入 Excel (BIFF) 格式檔案。實測 1MB 資料不足 10 秒完成，無需額外軟體安裝。

核心程式碼

先定義 Excel BIFF 記錄結構常數陣列：

arXlsBegin: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);      // BOF
arXlsEnd:   array[0..1] of Word = ($0A, 00);                     // EOF
arXlsString: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);       // LabelSst / 字串
arXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);         // Number / 浮點數
arXlsInteger: array[0..4] of Word = ($27E, 10, 0, 0, 0);        // Integer / 整數
arXlsBlank:  array[0..4] of Word = ($201, 6, 0, 0, $17);        // Blank / 空白

匯出函數 ExportExcelFile：

procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet);
var
  i, j: Integer;
  Col, Row: Word;
  ABookMark: TBookmark;
  aFileStream: TFileStream;

  procedure IncColRow; // 遞增行列索引
  begin
    if Col = aDataSet.FieldCount - 1 then begin Inc(Row); Col := 0; end
    else Inc(Col);
  end;

  procedure WriteStringCell(AValue: string); // 寫入字串
  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(Pointer(AValue)^, 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
  if FileExists(FileName) then DeleteFile(FileName);
  aFileStream := TFileStream.Create(FileName, fmCreate);
  try
    // 寫檔頭
    aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin));
    // 寫欄位標題
    Col := 0; Row := 0;
    if bWriteTitle then
      for i := 0 to aDataSet.FieldCount - 1 do
        WriteStringCell(aDataSet.Fields[i].FieldName);
    // 寫資料
    aDataSet.DisableControls;
    ABookMark := aDataSet.GetBookmark;
    aDataSet.First;
    while not aDataSet.Eof do begin
      for i := 0 to aDataSet.FieldCount - 1 do
        case aDataSet.Fields[i].DataType of
          ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
            WriteIntegerCell(aDataSet.Fields[i].AsInteger);
          ftFloat, ftCurrency, ftBCD:
            WriteFloatCell(aDataSet.Fields[i].AsFloat);
        else
          WriteStringCell(aDataSet.Fields[i].AsString);
        end;
      aDataSet.Next;
    end;
    // 寫檔尾
    aFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));
    // 還原書籤
    if aDataSet.BookmarkValid(ABookMark) then aDataSet.GotoBookmark(ABookMark);
  finally
    aFileStream.Free;
    aDataSet.EnableControls;
  end;
end;

使用說明

• 參數：FileName 完整路徑、bWriteTitle 是否寫入欄位名、aDataSet 任意 TDataSet 子類別（TTable、TQuery、TADODataSet 等）。
• 自動處理整數、浮點數、字串三大類型，其他型別以字串輸出。
• 在 Delphi 6 測試通過。