用流导出excel

关注……俺是老老实实用COM做的。

这是我刚解决的问题
和你问的一样
http://community.csdn.net/Expert/topic/3593/3593609.xml?temp=.1481592

To zglwxb(放狗咬人地)
兄弟，谢谢，你哪一题俺也回答了,你的答案俺看不明啊:
，能不能解释一下:
CBOF      = $0009;
  BIT_BIFF5 = $0800;
  BOF_BIFF5 = CBOF or BIT_BIFF5;
{EOF}
  BIFF_EOF = $000a;
{Document types}
  DOCTYPE_XLS = $0010;
{Dimensions}
  DIMENSIONS = $0000;
À³¸Ó¬O¤£¥i¯à¤j©ó 65535, ©Ò¥H¤£¦A³B²z
  maxRows:=65535; // <2002-11-17> dllee ³oÓ®æ¦¡³Ì¤j¥u¯à³o»ò¤j¡A½Ðª`·N¤jªº¸ê®Æ®w«Ü®e©ö´N¤j©ó³oÓÈ
end;

ADO应该是可以连接到Excel文件的，使用ADO连接数据库做，难道不行吗？

那是注释的,具体我也不知道
如果你不追求速度,或记录少的,可以用以下的代码试试
***********
(1)
if SaveDialog1.Execute then
  begin
    Screen.Cursor:=crHourGlass;
    ExcelApplication1.Connect;
    ExcelApplication1.Workbooks.Add(Null,0);
    ExcelWorkBook1.ConnectTo(ExcelApplication1.Workbooks[1]);
    ExcelWorkSheet1.ConnectTo(ExcelWorkBook1.Sheets[1] as _WorkSheet);
    if not adoQuery1.Active then
    begin
      adoQuery1.Open;
    end;
    for i:=0 to adoQuery1.Fields.Count-1 do
      ExcelWOrkSheet1.Cells.Item[1,i+1]:=adoQuery1.Fields[i].FieldName;
    row:=2;
    while not adoQuery1.Eof do
    begin
      for i:=0 to adoQuery1.Fields.Count-1 do
      begin
        ExcelWOrkSheet1.Cells.Item[row,i+1]:=adoQuery1.Fields[i].AsString;
      end;
      row:=row+1;
      adoQuery1.Next;
    end;
    ExcelWorkBook1.SaveCopyAs(SaveDialog1.FileName);
    ExcelWOrkBook1.Close(false);
    ExcelApplication1.Disconnect;
    ExcelApplication1.Quit;
    Screen.Cursor:=crDefault;
    Application.MessageBox('Export successfully!','Information',0);
  end;
end;
**************************
(2)
  Try
    ExcelApplication1.Connect;
  Except
    MessageDlg('Excel may not be installed',
      mtError, [mbOk], 0);
    Abort;
  End;
  ExcelApplication1.Visible[0] := True;
  ExcelApplication1.Caption := 'Excel Application';
  ExcelApplication1.Workbooks.Add(Null, 0);
  ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
  ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);
  DBGrid1.DataSource.DataSet.Open;
  row := 1;
  While Not (DBGrid1.DataSource.DataSet.Eof) do
  begin
    column := 1;
    for i := 1 to DBGrid1.DataSource.DataSet.FieldCount do
    begin
      ExcelWorksheet1.Cells.Item[row, column] := DBGrid1.DataSource.DataSet.fields[i - 1].AsString;
      column := column + 1;
    end;
    DBGrid1.DataSource.DataSet.Next;
    row := row + 1;
  end;

To CloneCenter(复制中心) 谢谢，老师，因为了用OLE太慢，要一条一条的来，有没有一种利用文件流的方式进行写入 fmcreate
execel文件流中了.

To zglwxb(放狗咬人地)
兄弟，我有同你一样有两种方式（一种一用控件另一种是用comobj)，但是,如果记录多有个几十万条，就不行了. 不知有没有一种用文件流 fmcreate成excel文件

接觸delphi已經2個月了，可是縂感覺還沒入門，什麽都要問。
在主管和csdn裏的朋友們的幫助下，一個倉庫管理系統已經到了調試階段了。
打開一個Form縂有些莫名其妙的報錯，'OLE Error 80040E14' 只要一修改。。隨便
加一個message 然後編譯都報上面的錯，可多編譯幾次又正常了。。反反復復。。喐悶死了！！！！幫忙亞！！！！！！

我现在是这中方法
导出3W条16个字段公用时1分5秒，而且是读去网络上的数据
勉强可以接受
不过听说可先导成ACCSEE然后在转成EXCEL，但兄弟我弄不出来~_~
我没有其他办法了
**************
unit UnitXLSFile;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Grids, Forms, Dialogs,db,dbctrls,comctrls;const
{BOF}
  CBOF      = $0009;
  BIT_BIFF5 = $0800;
  BOF_BIFF5 = CBOF or BIT_BIFF5;
{EOF}
  BIFF_EOF = $000a;
{Document types}
  DOCTYPE_XLS = $0010;
{Dimensions}
  DIMENSIONS = $0000;type
  TAtributCell = (acHidden,acLocked,acShaded,acBottomBorder,acTopBorder,
                acRightBorder,acLeftBorder,acLeft,acCenter,acRight,acFill);  TSetOfAtribut = set of TatributCell;  TXLSWriter = class(Tobject)
  private
    fstream:TFileStream;
    procedure WriteWord(w:word);
  protected
    procedure WriteBOF;
    procedure WriteEOF;
    procedure WriteDimension;
  public
    maxCols,maxRows:Word;
    procedure CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
    procedure CellDouble(vCol,vRow:word;aValue:double;vAtribut:TSetOfAtribut=[]);
    procedure CellStr(vCol,vRow:word;aValue:String;vAtribut:TSetOfAtribut=[]);
    procedure WriteField(vCol,vRow:word;Field:TField);
    constructor create(vFileName:string);
    destructor destroy;override;
  end;procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
procedure DataSetToXLS(ds:TDataSet;fname:String);
procedure StringGridToXLS(grid:TStringGrid;fname:String);implementation
uses
  unit1;procedure DataSetToXLS(ds:TDataSet;fname:String);
var
  c,r:Integer;
  xls:TXLSWriter;
begin
  xls:=TXLSWriter.create(fname);
  if ds.FieldCount > xls.maxcols then
    xls.maxcols:=ds.fieldcount+1;
  try
    xls.writeBOF;
    xls.WriteDimension;
    for c:=0 to ds.FieldCount-1 do
      xls.Cellstr(0,c,ds.Fields[c].DisplayLabel);
    r:=1;
    ds.first;
    while (not ds.eof) and (r <= xls.maxrows) do begin
      for c:=0 to ds.FieldCount-1 do
        if ds.Fields[c].AsString<>'' then
          xls.WriteField(r,c,ds.Fields[c]);
      inc(r);
      ds.next;
    end;
    xls.writeEOF;
  finally
    xls.free;
  end;
end;procedure StringGridToXLS(grid:TStringGrid;fname:String);
var c,r,rMax:Integer;
  xls:TXLSWriter;
begin
  xls:=TXLSWriter.create(fname);
  rMax:=grid.RowCount;
  if grid.ColCount > xls.maxcols then
    xls.maxcols:=grid.ColCount+1;
  if rMax > xls.maxrows then          // ¦¹®æ¦¡³Ì¦h¥u¯à¦s 65535 Rows
    rMax:=xls.maxrows;
  try
    xls.writeBOF;
    xls.WriteDimension;
    for c:=0 to grid.ColCount-1 do
      for r:=0 to rMax-1 do
        xls.Cellstr(r,c,grid.Cells[c,r]);
    xls.writeEOF;
  finally
    xls.free;
  end;
end;{ TXLSWriter }constructor TXLSWriter.create(vFileName:string);
var
  date :TDateTime;
begin
  inherited create;
  date:=now;
// showmessage(DateTOStr(date));
vFilename:=ExtractFilePath(Application.ExeName)+DateTOStr(date)+' '+frm_main.f_name+'.xls';
  if FileExists(vFilename) then
    fStream:=TFileStream.Create(vFilename,fmOpenWrite)
  else
    fStream:=TFileStream.Create(vFilename,fmCreate);  maxCols:=100;   // <2002-11-17> dllee Column À³¸Ó¬O¤£¥i¯à¤j©ó 65535, ©Ò¥H¤£¦A³B²z
  maxRows:=65535; // <2002-11-17> dllee ³oÓ®æ¦¡³Ì¤j¥u¯à³o»ò¤j¡A½Ðª`·N¤jªº¸ê®Æ®w«Ü®e©ö´N¤j©ó³oÓÈ
end;destructor TXLSWriter.destroy;
begin
  if fStream <> nil then
    fStream.free;
  inherited;
end;procedure TXLSWriter.WriteBOF;
begin
  Writeword(BOF_BIFF5);
  Writeword(6);           // count of bytes
  Writeword(0);
  Writeword(DOCTYPE_XLS);
  Writeword(0);
end;procedure TXLSWriter.WriteDimension;
begin
  Writeword(DIMENSIONS);  // dimension OP Code
  Writeword(8);           // count of bytes
  Writeword(0);           // min cols
  Writeword(maxRows);     // max rows
  Writeword(0);           // min rowss
  Writeword(maxcols);     // max cols
end;procedure TXLSWriter.CellDouble(vCol, vRow: word; aValue: double;
  vAtribut: TSetOfAtribut);
var  FAtribut:array [0..2] of byte;
begin
  Writeword(3);           // opcode for double
  Writeword(15);          // count of byte
  Writeword(vCol);
  Writeword(vRow);
  SetCellAtribut(vAtribut,fAtribut);
  fStream.Write(fAtribut,3);
  fStream.Write(aValue,8);
end;procedure TXLSWriter.CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
var  FAtribut:array [0..2] of byte;
begin
  Writeword(2);           // opcode for word
  Writeword(9);           // count of byte
  Writeword(vCol);
  Writeword(vRow);
  SetCellAtribut(vAtribut,fAtribut);
  fStream.Write(fAtribut,3);
  Writeword(aValue);
end;procedure TXLSWriter.CellStr(vCol, vRow: word; aValue: String;
  vAtribut: TSetOfAtribut);
var  FAtribut:array [0..2] of byte;
  slen:byte;
begin
  Writeword(4);           // opcode for string
  slen:=length(avalue);
  Writeword(slen+8);      // count of byte
  Writeword(vCol);
  Writeword(vRow);
  SetCellAtribut(vAtribut,fAtribut);
  fStream.Write(fAtribut,3);
  fStream.Write(slen,1);
  fStream.Write(aValue[1],slen);
end;procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
var
   i:integer;
begin
//reset
  for i:=0 to High(FAtribut) do
    FAtribut[i]:=0;
     if  acHidden in value then       //byte 0 bit 7:
         FAtribut[0] := FAtribut[0] + 128;     if  acLocked in value then       //byte 0 bit 6:
         FAtribut[0] := FAtribut[0] + 64 ;     if  acShaded in value then       //byte 2 bit 7:
         FAtribut[2] := FAtribut[2] + 128;     if  acBottomBorder in value then //byte 2 bit 6
         FAtribut[2] := FAtribut[2] + 64 ;     if  acTopBorder in value then    //byte 2 bit 5
         FAtribut[2] := FAtribut[2] + 32;     if  acRightBorder in value then  //byte 2 bit 4
         FAtribut[2] := FAtribut[2] + 16;     if  acLeftBorder in value then   //byte 2 bit 3
         FAtribut[2] := FAtribut[2] + 8;     // <2002-11-17> dllee ³Ì«á 3 bit À³¥u¦³ 1 ºØ¿ï¾Ü
     if  acLeft in value then         //byte 2 bit 1
         FAtribut[2] := FAtribut[2] + 1
     else if  acCenter in value then  //byte 2 bit 1
         FAtribut[2] := FAtribut[2] + 2
     else if acRight in value then    //byte 2, bit 0 dan bit 1
         FAtribut[2] := FAtribut[2] + 3
     else if acFill in value then     //byte 2, bit 0
         FAtribut[2] := FAtribut[2] + 4;
end;procedure TXLSWriter.WriteWord(w: word);
begin
  fstream.Write(w,2);
end;procedure TXLSWriter.WriteEOF;
begin
  Writeword(BIFF_EOF);
  Writeword(0);
end;procedure TXLSWriter.WriteField(vCol, vRow: word; Field: TField);
begin
  case field.DataType of
     ftString,ftWideString,ftBoolean,ftDate,ftDateTime,ftTime:
       Cellstr(vcol,vrow,field.asstring);
     ftAutoInc,ftSmallint,ftInteger,ftWord:
       CellWord(vcol,vRow,field.AsInteger);
     ftFloat, ftBCD:
       CellDouble(vcol,vrow,field.AsFloat);
  else
       Cellstr(vcol,vrow,EmptyStr);   // <2002-11-17> dllee ¨ä¥L«¬ºA¼g¤JªÅ¥Õ¦r¦ê
  end;
end;
end.

如果10W条记录,可能很慢,我可以用
select * from openrowset('Microsoft.jet.oledb.4.0',
'c:\test.mdb';'admin','','select * from test') 我觉得还是用流比较快，还不知怎么处理，请高手相助

研究一下DBGRIDEH和DXGRID，两者都有一个类（单独的PAS文件，名称忘记了，好像是IMP/EXP之类，可以导入导出，包括txt/cvs/html/excel/dbf等格式，做得非常好，完全的面向对象方法做的。导出EXCEL是用流的方式，速度很快，不过只支持相应的GRID。谁来改动一下做成支持DBGRID的就爽了。

解决方案 »