首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > .NET > .NET >

delphi导出到excel,默认路径和excel名称。该怎么处理

2012-04-06 
delphi导出到excel,默认路径和excel名称。要把dbgrid里的内容导出到excel,默认到D盘下data文件夹里。默认保

delphi导出到excel,默认路径和excel名称。
要把dbgrid里的内容导出到excel,默认到D盘下data文件夹里。默认保存的excel名称为当天的日期那种,比如今天就是041201.如果今天点过一次保存了,再点就提示说已经存在此文件。
 
以前我只会导出excel,但是弹出选择路径的对话框,这次不让弹出了,就直接保存到d:\data\041201。


怎么写?
我以前的导出excel代码如下,也是从网上粘的:

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  XLApp: Variant;
  Sheet: Variant;
  WordApp, WordDoc, WordParagraph, WordRange, WordTable: Variant;
  I, J: Integer;
  SaveDialog: TSaveDialog;
  pBookMark: TBookMark;
  StrSaveFile: string;
  IntFileType: Integer;
  SltRec,SltCol: Integer;
  ColIndex, RowIndex: Integer;
  DBGridName:TDBGrid;
begin
DBGridName:=DBGrid2;

  if DBGridName.DataSource.DataSet.IsEmpty then begin
  MessageBox(Application.Handle, '没有任何数据,不能进行保存', '警告', MB_OK);
  Abort;
  end;
  SaveDialog := TSaveDialog.Create(nil);
  SaveDialog.Filter := 'Microsoft Excel 文件|*.xls|Microsoft Word 文件|*.doc';
  SaveDialog.Execute;
  IntFileType := SaveDialog.FilterIndex;
  StrSaveFile := SaveDialog.FileName;
  if Length(StrSaveFile) = 0 then Exit;
  try
  Screen.Cursor:=crHourGlass;
  case IntFileType of
  1: begin
  try
  XLApp :=CreateOleObject('Excel.Application');
  XLApp.WorkBooks.Add(-4167);
  XLApp.WorkBooks[1].WorkSheets[1].Name := '导出数据';
  Sheet := XLApp.WorkBooks[1].WorkSheets['导出数据'];  
  J := 1;  
  except
  MessageBox(GetActiveWindow,'无法调用Mircorsoft Excel! '+chr(13)+chr(10)+  
  '请检查是否安装了Mircorsoft Excel。','提示',MB_OK+MB_ICONINFORMATION);  
  Exit;
  end;  
  with DBGridName.DataSource.DataSet do
  begin  
  pBookMark := GetBookmark;
  DisableControls;  
  for I:=0 to DBGridName.Columns.Count-1 do
  begin
  if not DBGridName.Columns[I].Visible then
  Continue;  
  Sheet.Cells[J,I+1] := dbgridname.Columns[I].Title.Caption;  
  end;  
  Inc(J);
  First;  
  while not Eof do begin  
  for I := 0 to DBGridName.Columns.Count-1 do begin  
  if not DBGridName.Columns[I].Visible then
  Continue;  
  Sheet.Cells[J,I+1] := Trim(DBGridName.DataSource.DataSet.FieldByName(DBGridName.Columns[i].FieldName).AsString);  
  end;  
  Inc(J);
  Next;  
  end;  
  GotoBookmark(pBookMark);  
  FreeBookmark(pBookMark);
  EnableControls;  
  end;  
  XLApp.activeworkbook.saveas(StrSaveFile);  
  Application.ProcessMessages;
  XLApp.Application.Quit;  


  end;  
  2: begin  
  try
  if VarIsEmpty(WordApp) then  
  WordApp := CreateOleObject('word.Application');  
  WordDoc := WordApp.Documents.Add;  
  WordParagraph := WordApp.ActiveDocument.Paragraphs.Add;
  WordRange := WordParagraph.Range;  
  WordRange.Font.Size := 15;  
  WordRange.Font.Name := '宋体';  
  except
  MessageBox(GetActiveWindow,'无法调用Mircorsoft Word! '+Chr(13)+Chr(10)+  
  '请检查是否安装了Mircorsoft Word。','提示',MB_OK+MB_ICONINFORMATION);  
  Abort;  
  end;
  SltRec := DBGridName.SelectedRows.Count;  
  SltCol := 0;  
  for J := 0 to DBGridName.Columns.Count - 1 do begin
  if DBGridName.Columns[J].Visible then  
  SltCol := SltCol +1;
  end;  
   
  WordRange := WordApp.ActiveDocument.Content;  
  WordTable := WordApp.ActiveDocument.Tables.Add(WordRange,SltRec + 1,SltCol);  
  ColIndex := 1;
   
  for J := 0 to DBGridName.Columns.Count - 1 do begin  
  if (not DBGridName.Columns[J].Visible) then  
  Continue;  
  WordTable.Cell(1, ColIndex).Range.InsertAfter(DBGridName.Columns[J].Title.Caption);
  ColIndex := ColIndex + 1;  
  end;  
   
  RowIndex := 2;  
  ColIndex := 1;
  with DBGridName.DataSource.DataSet do begin  
  First;  
  pBookMark := GetBookmark;  
  DisableControls;  
  while not Eof do begin
  for j := 0 to DBGridName.Columns.Count-1 do begin  
  if (DBGridName.Columns[j].Visible<>false) then  
  begin  
  WordTable.Cell(RowIndex,ColIndex).Range.InsertAfter
  (DBGridName.DataSource.DataSet.Fieldbyname(DBGridName.Columns[j].FieldName).AsString);
  ColIndex := ColIndex + 1;  
  end;  
  end;  
  RowIndex := RowIndex + 1;  
  ColIndex := 1;
  Next;  
  end;  
  GotoBookmark(pBookMark);  
  FreeBookmark(pBookMark);  
  EnableControls;
  end;  
  WordApp.ActiveDocument.SaveAs(StrSaveFile);
  Application.ProcessMessages;
  WordApp.Application.Quit;  
  end;
  end;  
  finally  
  SaveDialog.Free;  


  Screen.Cursor := crDefault;
  end;
  showmessage('导出成功!');

end;


[解决办法]
XLApp :=CreateOleObject('Excel.Application');

XLApp.visible:=false; //add

XLApp.WorkBooks.Add(-4167);

..........
XLApp.DisplayAlerts := False; //add

XLApp.activeworkbook.saveas(StrSaveFile);
[解决办法]
这么点改动也要问?
SaveDialog.FileName这个改为需要保存的文件名(含路径)
保存前先判断该文件名是否已经存在FileExists
[解决办法]
操作excel word ole文档之类的,保存有个saveas方法吧,有选择项选择是否覆盖,

你仔细看看,方法提供了
[解决办法]

Delphi(Pascal) code
  SaveDialog1.FileName := formatdatetime('yyyymmdd',now())+'.xls';  SaveDialog1.InitialDir := 'D:\';  if FileExists(SaveDialog1.FileName) then  begin    messagebox(handle,'已经存在','提示',MB_ICONINFORMATION);    Exit;  end;  if SaveDialog1.Execute then  begin    .......    .......  end; 

热点排行