Delhpi利用剪贴板快速导出(复制)数据到excel

 

本文介绍一种将数据复制到剪贴板,然后粘帖到excel的技术,目的是快速将数据导入到excel文件。实践证明,普通的电脑可以每秒导入2000条数据以上.网上已有这方面的文章,本人也将自己的实践经历告诉一下大家,以供大家参考.

Delphi中将数据导入excel文件,通常会使用OLE技术.可这种技术有一个缺点，那就是速度很慢,一般一秒钟可以导出100条左右.这对于导出大量的数据,确实是令人难以忍受.

有人使用文件流的方式，通过TfileStream直接写入Excel文件.这种方法速度很快,但有一个很大的缺陷,就是所有的数据只能写入到excel的一个sheet中,因此如果导入的数据量超过了一个sheet的最大存储量(excel2003是65536条),那么多余的数据就会丢失.

因此本人就想要介绍上述的剪贴板技术了呵呵.

下面的代码实现把一个txt文件的内容导入(或说复制如)excel文件.

如果你是将数据库中的内容导入excel文档,那么也很简单,先将 要导入的记录的内容 保存到stringlist中,然后再调用strListToExcel函数.

顺便也介绍一点基础知识吧,可以认为excel中单元格之间是使用tab(ascii码是9)分隔的,所以如果你的txt文件中没有tab键,那么复制到excel中的话只能复制到一个单元格中.要想把你txt中的内容复制到excel的多个单元格中,就需要在txt中用tab将内容分隔开呵呵.

对了,不要忘了引用相关单元, uses IniFiles,Classes,ComObj,SysUtils,Variants,StdCtrls,Clipbrd;

 

//主函数,按下一个按钮,就将'c:/test.txt'的内容导入'c:/test.xls'

procedure TForm1.Button1Click(Sender: TObject);

begin

   txtFileToExcel('c:/test.txt','c:/test.xls');

end;

 

//将txt文件的内容导入excel文件,

// txtFileStr是txt文件的文件名, excelFileStr是excel文件的文件名.其中

//excel文件可以不存在(因为在程序中会创建).

procedure txtFileToExcel(txtFileStr:string;excelFileStr:string);

var

  strList:tstringlist;

begin

  strList:=TStringList.Create();

  strlist.LoadFromFile(txtFileStr);

  strListToExcel(strList,excelFileStr);

end;

 

//将一个stringlist的内容导入excel文档,该函数供txtFileToExcel函数调用

//stringlist的最大行数是3个excel的sheet所能存储的行数,即65536*3行

procedure strListToExcel(strList:tstringlist;excelFileStr:string);

var

  strList2:tstringlist;

  app,workBook:Variant;

  clpb:TClipboard;

  pasteTime:integer;

  line:integer;

  startLine:integer;

  i:integer;

begin

  clpb:=TClipboard.Create;

 

  CoInitializeEx(nil, 0);

  try

    app:=createoleobject('Excel.Application');

  except

    raise exception.create('您的电脑里未安装excel软件');

  end;

 

  try

  //app.ScreenUpdating:=false;

  workbook:=deleteAndCreateXlsFile(excelFileStr,app);

 

  //下面3句话写的确实很无奈哎,如果文本中有长的数字串(如身份证号),就需要将excel中的相应单元格

  //设为文本格式,否则可能会丢失数据.

  //workbook.Sheets[1].columns[4].NumberFormatLocal:='@';

  //workbook.Sheets[2].columns[4].NumberFormatLocal:='@';

 // workbook.Sheets[3].columns[4].NumberFormatLocal:='@';

 

  //<=65536,一次性粘帖到sheet1中

  if(strlist.Count<=65536)then

  begin

     clpb.AsText:=strList.Text;

     //workbook.Sheets[1].Activate;

     workbook.Sheets[1].cells[1,1].select;

     workbook.Sheets[1].paste;

  end

  else

  begin

    if( strlist.Count mod 65536=0)then

    begin

      pasteTime:=strlist.Count div 65536;

    end

    else

    begin

      pasteTime:=strlist.Count div 65536+1;

    end;

    if(pasteTime>3)then

    begin

      raise Exception.Create('数据量过大,超出了excel的sheet3');

    end;

    //前面的sheet(除最后一个sheet)

    for i:=1 to pasteTime-1 do

    begin

      strList2:=TStringList.Create();

      // startLine为第一条对应 strList的序号.

      startLine:=65536*(i-1);

      for line:=1 to 65536 do

      begin

        strList2.Add(strList.Strings[startLine+line-1]);

      end;

      clpb.AsText:=strList2.Text;

      workbook.WorkSheets[i].Activate;

      workbook.Sheets[i].cells[1,1].select;

      workbook.Sheets[i].paste;

      strList2.Free;

    end;

 

    //最后一个sheet

    strList2:=TStringList.Create();

    // startLine为第一条对应 strList的序号.

    startLine:=65536*(pasteTime-1);

    for line:=1 to (strlist.Count mod 65536) do

    begin

        strList2.Add(strList.Strings[startLine+line-1]);

    end;

    clpb.AsText:=strList2.Text;

    workbook.WorkSheets[pasteTime].Activate;

    workbook.Sheets[pasteTime].cells[1,1].select;

    workbook.Sheets[pasteTime].paste;

    strList2.Free;

  end;

  strList.Free;

 

  finally

  //app.ScreenUpdating:=true;

  workbook.save;

  app.workbooks.close;

  app.quit;

  end;

end;

 

 

//删除并创建一个excel文档,该函数供strListToExcel函数调用

function deleteAndCreateXlsFile(fileStr:string;app:variant):variant;

var

 b:boolean;

 workbook:variant;

begin

  workbook:=app.workBooks.Add;

  if(fileexists(filestr))then

  begin

    b:=deletefile(filestr);

    if(b=false)then

    begin

      raise Exception.Create('删除'+fileStr+'文件失败');

    end;

  end;

  WorkBook.saveas(fileStr);

  result:=workbook;

end;