将数据库内容导入Excel并保存(附源代码):procedure WriteDatasetToExcel(AQueryName: TQuery; AStrVar: String);

Question

procedure WriteDatasetToExcel(AQueryName: TQuery; AStrVar: String);
var
  EclApp,WorkBook : Variant;
  xlsFileName : String ;
  I : Integer ;
  column : Integer ;
  Row : Integer ;
  Fdate:TDateTime;
  Year, Month, Day, Hour, Min, Sec, MSec: Word;
  StrDate:String ;
  StrDate1:String ;
Begin
  Fdate:=now ;
  DecodeDate(Fdate, Year, Month, Day);
  DecodeTime(Fdate, Hour, Min, Sec, MSec);
  StrDate:=formatdatetime('yyyy-mm-dd-hh-mm-ss',Fdate) ;
  StrDate1:=formatdatetime('yyyy/mm/dd hh:mm:ss',Fdate) ;
  If AStrVar='Excel文件' Then
  Begin
  xlsfilename :='Excel文件';
  End ;  Try
    Begin
      EclApp := CreateOleObject('Excel.Application');
      WorkBook:=CreateOleObject('Excel.Sheet');
    End
  Except
    ShowMessage('您的計算机上沒有Microsoft Excel!');
    Exit;
  end;
  try
    workBook:=EclApp.workBooks.Add ;
    row:=2;
    EclApp.Workbooks.Item[1].Activate;
    eclApp.Cells.font.colorindex:=5 ;
    EclApp.Activesheet.Cells(1,1):=AStrVar ;
    For I := 1 To AQueryName.FieldCount Do
      EclApp.Activesheet.Cells(2,I):=AQueryName.Fields[I-1].FieldName ;
    If Not AQueryName.Active Then AQueryName.Active := True ;
    AQueryName.First;
  While Not(AQueryName.Eof) do
  begin
    column:=1;
    for i:=1 to AQueryName.FieldCount do
    begin
      eclApp.Cells.Item[row+1,column]:=AQueryName.fields[i-1].AsString;
      column:=column+1;
    end;
    AQueryName.Next;
    row:=row+1;
  End;
  WorkBook.saveas(xlsFileName);
  WorkBook.close;
  WorkBook:=eclApp.workBooks.Open(xlsFileName);
  if MessageDlg('xlsFileName'+'此文件是否保存?',
  mtConfirmation,[mbYes, mbNo], 0) = mrYes then
    WorkBook.save
  Else
    workBook.Saved := True;
    WorkBook.Close;
    eclApp.Quit;
    eclApp:=Unassigned;
  except
    ShowMessage('Excel文件保存失敗');
    WorkBook.close;
    eclApp.Quit; 
    eclApp:=Unassigned;
  end;
  ShowMessage('EXCEL 文件保存完畢。');
end;