Delphi7 导出Dbgrid数据到Excel 默认路径设置为我的文档

下面代码是自己写的，今天有个同学打电话问我

在Delphi7 导出Dbgrid数据到Excel 正好我最近写过 

也许会有更多的网友也会遇到类似的问题，把代码发下，

大家可以参考，有什么不足及需要改进的地方，请指教。

让我们共同学习。

procedure TFPeopleMgr.N6Click(Sender: TObject);

var

j:   integer;

filename:   string;

MSExcel,xlsheet,xlBook :   Variant;      //ole   ComObj

reg:Tregistry;

MYDocumentPath:   string; 

begin

IF DBGrid1.Fields[0].AsString='' then

begin

    Application.MessageBox('列表为空，无法导出！','错误操作',MB_OK+MB_ICONError);

    exit;

end;

//获得“我的文档”的路径

reg:=Tregistry.create;

reg.rootkey:=HKey_Current_User;

reg.openkey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders',false);

MYDocumentPath:=reg.READString('Personal');//“我的文档”的路径

SaveDialog1.InitialDir:=MYDocumentPath;

reg.closekey;

reg.free;

//导出数据

if TreeView_Dep.Selected=nil then

begin

    SaveDialog1.FileName:='人员信息 '+datetostr(now);

end

else

    SaveDialog1.FileName:=TreeView_Dep.Selected.Text+'人员信息 '+datetostr(now);

if SaveDialog1.Execute then

begin

    filename := concat(SaveDialog1.FileName,'.xls');

    try

       MSExcel:=CreateOLEObject('Excel.Application');

       xlBook:=MSExcel.WorkBooks.Add;

       xlsheet:=xlBook.Worksheets['sheet1'];

       xlsheet.Cells.item[1,1]:='编号';

       xlsheet.Cells.item[1,2]:='姓名';

       xlsheet.Cells.item[1,3]:='考勤号';

       xlsheet.Cells.item[1,4]:='单位';

       xlsheet.Cells.item[1,5]:='职务';

       j:=1;

       qe_ren.First;

       while   not   qe_ren.Eof   do   begin

         DBGrid1.SelectedRows.CurrentRowSelected   :=   True;

         xlsheet.Cells.item[j+1,1]:=DBGrid1.Fields[0].AsString;

         xlsheet.Cells.item[j+1,2]:=DBGrid1.Fields[1].AsString;

         xlsheet.Cells.item[j+1,3]:=DBGrid1.Fields[2].AsString;

         xlsheet.Cells.item[j+1,4]:=DBGrid1.Fields[3].AsString;

         xlsheet.Cells.item[j+1,5]:=DBGrid1.Fields[4].AsString;

         qe_ren.Next;

         j:=J+1;

       end;//while

       xlBook.SaveAs(filename);

       MSExcel.WorkBooks.close;

       MSExcel.Quit;

       MSExcel:=unassigned;

    except

      Application.Messagebox('Excel没有安装!','错误提示',MB_ICONERROR+mb_Ok);

      exit;

    end;//try

end;// end if SaveDialog1.Execute then

end;

转载请注明出处。

在使用控件dbgrideh导出excel后，excel2010提示文件已损坏，想通过程序判断excel的版本，如果是2010版就通过ole导出，（通过注册表或者文件目录等其他方法都可以），望高手指点！！ 更多0分享到： 相关主题推荐： excel 注册表 控件 2010 相关帖子推荐： VS2102MFC控件，如何授权。数字签名向导出不来 excel怎样按某列的值分组统计其平均值 如何编程获取windows里软件的安装路径？ 关于打印时隐藏控件的问题 C# excel导入数据 控件随对话框变化，但是有个问题，当对话框最小化时，作为被除数的m_rect.Width()函数值就是0，请教大神怎么改啊？ asp.net 导出Excel MFC 嵌入 Windows Media Player 控件

对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理 回复次数：3

xiaojun5556 xiaojun5556 等级：

#1 得分：40回复于： 2012-12-18 14:00:32 function hasExcel2010(): Boolean; var   MyReg: TRegistry; begin // HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\SOFTWARE\Microsoft\Office\14.0   Result := False;   MyReg := TRegistry.Create;   try     MyReg.RootKey := HKEY_LOCAL_MACHINE;     if MyReg.OpenKey('\SOFTWARE\', FALSE) then     begin        if MyReg.OpenKey('\SOFTWARE\Microsoft\Office\Software\Microsoft\Office\14.0', FALSE) then        begin          Result := True;        end        else if MyReg.OpenKey('\SOFTWARE\Microsoft\Office\14.0\Excel\InstallRoot', FALSE) then        begin          Result := MyReg.ValueExists('Path');        end        else if MyReg.OpenKey('\SOFTWARE\Microsoft\Office\14.0', FALSE) then        begin          Result := True;        end;        MyReg.CloseKey;     end;   finally     MyReg.Free;   end; end; function hasExcel2007(): Boolean; var   MyReg: TRegistry; begin // HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\12.0\Excel\InstallRoot\Path: C:\Program Files\...   Result := False;   MyReg := TRegistry.Create;   try     MyReg.RootKey := HKEY_LOCAL_MACHINE;     if MyReg.OpenKey('\SOFTWARE\', FALSE) then     begin        if MyReg.OpenKey('\SOFTWARE\Microsoft\Office\12.0\Excel\InstallRoot', FALSE) then        begin          Result := MyReg.ValueExists('Path');        end;        MyReg.CloseKey;     end;   finally     MyReg.Free;   end; end;

2014年1月微软MVP当选名单揭晓！ 对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理

szto2003 szto2003 等级：

#2 得分：0回复于： 2012-12-18 18:44:34 能用HKEY_CURRENT_USER下面的判断吗，因为好多公司的电脑没有HKEY_LOCAL_MACHINE的访问权限！！