TDBGrid 数据导入到execle

procedure TFxxlook.savetoexcel(dbname:TDBGrid);
var
  excelapp:Variant;
  page:Variant;
  i,j:Integer;
  savedialog:TSaveDialog;
  BM:TBookmark;
  strsavefile:string;
 
begin
   if dbname.DataSource.DataSet.IsEmpty then //判断TDBGRID是否有数据
      begin
        MessageBox(Application.Handle,'数据为空不能进行保存','警告',MB_OK);
        Abort;
        Exit;
      end;
   savedialog:=TSaveDialog.Create(nil); // 创建一个保存对话框
   savedialog.Filter:='*.xls|*.XLS';    //设置保存文件的后缀
   savedialog.Execute;                  //打开保存对话框
   strsavefile:=savedialog.FileName;    //保存文件的目录
 
   if Length(strsavefile)=0 then Exit;  //目录为空则退出程序
 
   try
     Screen.Cursor:=crhourglass; //屏幕指针形状
     try
       excelapp:=CreateOleObject('excel.application');
       excelapp.workbooks.add(-4167); //设置添加数据的大小
       excelapp.workbooks[1].worksheets[1].name:='数据库数据';//标签页名称
       page:=excelapp.workbooks[1].worksheets['数据库数据'];  //指定标签页
       j:=1;
     except
       MessageBox(GetActiveWindow,'请确认是否安装了EXCEL','提示',MB_OK+ MB_ICONINFORMATION);
       Exit;
     end;
     with dbname.DataSource.DataSet do
     begin
       BM:=GetBookmark;
       DisableControls;
 
       //将DBGRID中的标题插入到EXCEL表中首行
       for i:=0 to dbname.Columns.Count-1 do
       begin
         if dbname.Columns[1].Visible=False then
         Continue;
 
         page.cells[j,i+1]:=dbname.Columns[i].Title.Caption;
         page.cells[j,i+1].font.bold:=True;
       end;
       Inc(j);  //ECXEL表中的下一行
       First;
       while not Eof do
       begin
         for i:=0 to dbname.Columns.Count-1 do
         begin
           if dbname.Columns[i].Visible=False then
           Continue;
 
           //将指定行添加到EXCEL表中
           page.cells[j,i+1]:=Trim(dbname.DataSource.DataSet.fieldbyname
           (dbname.Columns[i].FieldName).AsString);
         end;
         Inc(j);   //EXCEL表中下一行
         Next;     //TDBGrid表中下一行
       end;
       GotoBookmark(BM);
       FreeBookmark(BM);
       EnableControls;
     end;
     excelapp.activeworkbook.saveas(strsavefile);  //将EXCEL表保存到指定目录下
     Application.ProcessMessages;
     excelapp.application.quit;
   finally
     savedialog.Free;
     Screen.Cursor:=crDefault;
   end;
end;