用传统的TQuery查询数据,然后把查询结果保存到Excel中(采用Delphi自带的Excel接口控件)
感觉速度非常慢,仅条记录就需要大概半分钟的时间以下为我用的代码var
    ExcelApp: TExcelApplication;
    ExcelBook: TExcelWorkbook;
    ExcelSheet: TExcelWorksheet;
    Qu: TQuery;procedure TFmHis.BtnSaveClick(Sender: TObject);   //保存查询结果
var
  i,j:integer;
begin
  if ((not Qu.Active) or (Qu.RecordCount=0)) then
  begin
    MessageBox(Application.Handle,'请先查询历史数据!!!','注意',MB_OK);
    exit;
  end;  try
    ExcelApp.Connect;
  except
    MessageBox(Application.Handle,'请先安装Excel!!!','注意',MB_OK);
    exit;
  end;  ExcelApp.Visible[0]:=true;
  ExcelBook.ConnectTo(ExcelApp.Workbooks.Add(TOleEnum(xlWBATWorksheet), 0));  ExcelSheet.ConnectTo(ExcelBook.Worksheets[1] as _Worksheet);
  ExcelSheet.Name := '历史数据'+FormatDateTime('yyyymmdd',Now);
  ExcelSheet.Activate;  ExcelSheet.Range['E1', 'E1'].Value := '历史数据查询结果表';
  with ExcelSheet.Range['E1', 'E1'].Font do
  begin
    Size := 26;
    Name := '隶书';
    FontStyle := 'Bold';
  end;  for j := 0 to Qu.FieldCount-1 do
    ExcelSheet.Cells.Item[3,j+1] := Qu.Fields[j].FieldName;
  ExcelSheet.Range['A3', Chr(Ord('A')+Qu.FieldCount-1)+'3'].Font.FontStyle := 'Bold';  ExcelSheet.Range['A4', Chr(Ord('A')+Qu.FieldCount-1)+IntToStr(Qu.RecordCount+3)].EntireColumn.NumberFormat := '@';
  i := 4;
  with Qu do
  begin
    First;
    while not Eof do
    begin
      for j := 0 to Qu.FieldCount-1 do
        ExcelSheet.Cells.Item[i,j+1] := Qu.Fields[j].AsVariant;
      Next;
      Inc(i);
    end;
    First;
  end;  try
    ExcelApp.Quit;
    ExcelSheet.Disconnect;
    ExcelBook.Disconnect;
    ExcelApp.Disconnect;
  except
  end;
end;

解决方案 »

  1.   

    http://dev.csdn.net/develop/article/22/22674.shtm
      

  2.   

    把网页上的代码复制到查询分析器,执行失败 :(用odbc的老说找不到驱动,用bcp的老说连不数据库(在dos下是正确的语句)
      

  3.   

    我一般用的是第三方控件实现的Excel格式文件的导出,不用自带Server 页的控件(要客户机上面安装了OFFICE 才能用啊,不友好)
    推荐:XLSReadWriteII 和dvexport 两款,很好用的,里面带帮助文件,
    直接将一个DataSet导出到一个外部的Excel文件中,无需安装OFFICE 也行的。
    只要指定几个属性,然后调用Write方法就OK。
    http://www.delphifans.com/ 上有的下。。
      

  4.   

    谢谢XLSReadWriteII找到了,代码果然简单,速度也确实快一些,但是他也是循环走的,所以数据很多的时候还是很慢,机器仍呈死机装dvexport没找到
      

  5.   

    导出Excel都是用循环的(我没见过别的方法) 速度慢主要不是因为循环(循环取出1万条记录试试)最快的方法是导出TXT,然后把扩展名改为.xls 另外还有格函数:
    procedure CopyDbDataToExcel(Target: TDbgrid);
    var
    iCount, jCount: Integer;
    XLApp: Variant;
    Sheet: Variant;
    begin
    Screen.Cursor := crHourGlass;
    if not VarIsEmpty(XLApp) then
    begin
    XLApp.DisplayAlerts := False;
    XLApp.Quit;
    VarClear(XLApp);
    end;
    //通过ole创建Excel对象
    try
    XLApp := CreateOleObject('Excel.Application');
    except
    Screen.Cursor := crDefault;
    Exit;
    end;
    XLApp.WorkBooks.Add['e:\1.xls'];    //你要把数据放在那里啊,先生成个文件在e:\1.xls
    XLApp.WorkBooks[1].WorkSheets[1].Name := '测试工作薄';
    Sheet := XLApp.Workbooks[1].WorkSheets['测试工作薄'];
    if not Target.DataSource.DataSet.Active then
    begin
    Screen.Cursor := crDefault;
    Exit;
    end;
    Target.DataSource.DataSet.first;for iCount := 0 to Target.Columns.Count - 1 do
    begin
    Sheet.cells[1, iCount + 1] := Target.Columns.Items[iCount].Title.Caption;
    end;
    jCount := 1;
    while not Target.DataSource.DataSet.Eof do
    begin
    for iCount := 0 to Target.Columns.Count - 1 do
    begin
    Sheet.cells[jCount + 1, iCount + 1] := Target.Columns.Items[iCount].Field.AsString;
    end;
    Inc(jCount);
    Target.DataSource.DataSet.Next;
    end;
    XlApp.Visible := True;
    Screen.Cursor := crDefault;
    end;
    速度不是很慢,可以接受~
      

  6.   

    曾经遇到这问题,数据量很大,很是烦人
    如果用SQL语句的话会好的多
    然后再根据具体情况进行EXCEL的格式的编辑
    这样就快多了 
    EXEC master..xp_cmdshell 'bcp DB.dbo.tablename out c:\a.xls -c -q -S"GNETDATA/GNETDATA" -U"sa" -P""'
    还有一个邹老大写的存储过程,这样你可以把SQL语句直接改改就行了
    /*--数据导出EXCEL

    导出查询中的数据到Excel,包含字段名,文件为真正的Excel文件
    ,如果文件不存在,将自动创建文件
    ,如果表不存在,将自动创建表
    基于通用性考虑,仅支持导出标准数据类型
    --邹建 2003.10--*//*--调用示例 p_exporttb @sqlstr='select * from 地区资料'
    ,@path='c:\',@fname='aa.xls',@sheetname='地区资料'
    --*/
    if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[p_exporttb]') and OBJECTPROPERTY(id, N'IsProcedure') = 1)
    drop procedure [dbo].[p_exporttb]
    GOcreate proc p_exporttb
    @sqlstr sysname, --查询语句,如果查询语句中使用了order by ,请加上top 100 percent
    @path nvarchar(1000), --文件存放目录
    @fname nvarchar(250), --文件名
    @sheetname varchar(250)='' --要创建的工作表名,默认为文件名
    as 
    declare @err int,@src nvarchar(255),@desc nvarchar(255),@out int
    declare @obj int,@constr nvarchar(1000),@sql varchar(8000),@fdlist varchar(8000)--参数检测
    if isnull(@fname,'')='' set @fname='temp.xls'
    if isnull(@sheetname,'')='' set @sheetname=replace(@fname,'.','#')--检查文件是否已经存在
    if right(@path,1)<>'\' set @path=@path+'\'
    create table #tb(a bit,b bit,c bit)
    set @sql=@path+@fname
    insert into #tb exec master..xp_fileexist @sql--数据库创建语句
    set @sql=@path+@fname
    if exists(select 1 from #tb where a=1)
    set @constr='DRIVER={Microsoft Excel Driver (*.xls)};DSN='''';READONLY=FALSE'
         +';CREATE_DB="'+@sql+'";DBQ='+@sql
    else
    set @constr='Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties="Excel 5.0;HDR=YES'
    +';DATABASE='+@sql+'"'--连接数据库
    exec @err=sp_oacreate 'adodb.connection',@obj out
    if @err<>0 goto lberrexec @err=sp_oamethod @obj,'open',null,@constr
    if @err<>0 goto lberr--创建表的SQL
    declare @tbname sysname
    set @tbname='##tmp_'+convert(varchar(38),newid())
    set @sql='select * into ['+@tbname+'] from('+@sqlstr+') a'
    exec(@sql)select @sql='',@fdlist=''
    select @fdlist=@fdlist+','+a.name
    ,@sql=@sql+',['+a.name+'] '
    +case when b.name in('char','nchar','varchar','nvarchar') then
     'text('+cast(case when a.length>255 then 255 else a.length end as varchar)+')'
    when b.name in('tynyint','int','bigint','tinyint') then 'int'
    when b.name in('smalldatetime','datetime') then 'datetime'
    when b.name in('money','smallmoney') then 'money'
    else b.name end
    FROM tempdb..syscolumns a left join tempdb..systypes b on a.xtype=b.xusertype
    where b.name not in('image','text','uniqueidentifier','sql_variant','ntext','varbinary','binary','timestamp')
    and a.id=(select id from tempdb..sysobjects where name=@tbname)
    select @sql='create table ['+@sheetname
    +']('+substring(@sql,2,8000)+')'
    ,@fdlist=substring(@fdlist,2,8000)exec @err=sp_oamethod @obj,'execute',@out out,@sql
    if @err<>0 goto lberrexec @err=sp_oadestroy @obj--导入数据
    set @sql='openrowset(''MICROSOFT.JET.OLEDB.4.0'',''Excel 5.0;HDR=YES
    ;DATABASE='+@path+@fname+''',['+@sheetname+'$])'exec('insert into '+@sql+'('+@fdlist+') select '+@fdlist+' from ['+@tbname+']')set @sql='drop table ['+@tbname+']'
    exec(@sql)
    returnlberr:
    exec sp_oageterrorinfo 0,@src out,@desc out
    lbexit:
    select cast(@err as varbinary(4)) as 错误号
    ,@src as 错误源,@desc as 错误描述
    select @sql,@constr,@fdlist
    EXEC master..xp_cmdshell 'bcp groupdata.dbo.projectsuma out "c:\10.xls" /c  /U"sa" -P"sa"'
      

  7.   

    我用DTS向导做是挺快的,就是不知道为什么,用SQL做会报错。我数据库和要保存的Excel不在一台机器有关系吗?楼上的程序好长啊,明天继续试先谢谢大家了
      

  8.   

    这个程序是成功的,速度也蛮快的,但是生成的Excel是在服务器上,而不是在本机用DTS就不能在本机生成Excel了吗?期待中
      

  9.   

    试试这个函数
    procedure TCustomCommonRoutine.SaveToExcel(FDataSet: array of TDataSet;
      Title, SubTitle, FileName: string);
    var
      i, j: Integer;
      sList: TStringList;
    begin
      sList := TStringList.Create;
      sList.Clear;
      if length(FDataSet) > 0 then
      begin
        sList.Add('<HTML>');
        sList.Add(#9 + '<HEAD>');
        sList.Add(#9 +
          '<meta http-equiv="content-type" content="text/html; charset=gb2312">');
        sList.Add(#9#9 + '<H2 align="center">');
        sList.Add(Title);
        sList.Add(#9#9 + '</H2>');
        sList.Add(#9#9 + '<H3 align="center">');
        sList.Add(SubTitle);
        sList.Add(#9#9 + '</H3>');
        sList.Add(#9 + '</HEAD>');
        sList.Add('<body>');
        sList.Add('<table width="100%" border="1">');
        for i := 0 to length(FDataSet) - 1 do
        begin
          with FDataSet[i] do
          begin
            sList.Add(#9 + '<tr>');
            for j := 0 to FDataSet[i].FieldCount - 1 do
            begin
              if FDataSet[i].Fields[j].Visible = true then
              begin
                sList.Add(#9#9 + '<td>');
                sList.Add(#9#9 + FDataSet[i].Fields[j].DisplayName);
                sList.Add(#9#9 + '</td>');
              end;
            end;
            sList.Add(#9 + '</tr>');
            if FDataSet[i].RecordCount > 0 then
            begin
              FDataSet[i].First;
              while not FDataSet[i].Eof do
              begin
                sList.Add(#9 + '<tr>');
                for j := 0 to FDataSet[i].FieldCount - 1 do
                begin
                  if fDataSet[i].Fields[j].Visible = true then
                  begin
                    sList.Add(#9#9 + '<td>');
                    sList.Add(#9#9 + trim(FDataSet[i].Fields[j].AsString));
                    sList.Add(#9#9 + '</td>');
                  end;
                end;
                sList.Add(#9 + '</tr>');
                FDataSet[i].next;
              end;
            end
            else
            begin
              sList.Add(#9 + '<tr>');
              for j := 0 to FDataSet[i].FieldCount - 1 do
              begin
                if fDataSet[i].Fields[j].Visible = true then
                begin
                  sList.Add(#9#9 + '<td>');
                  sList.Add(#9#9 + '');
                  sList.Add(#9#9 + '</td>');
                end;
              end;
              sList.Add(#9 + '</tr>');
            end;
          end;
        end;
        sList.Add('</table>');
        sList.Add('</body>');
        sList.SaveToFile(FileName+'.xls');
      end;
      sList.Free;
    end;