DbGridToExcel(Delphi)

procedure TFrm_func.DbGridToExcel( ADg: TDBGrid );
var
  xlApp, xlSheet: Variant;
  ARow, iLoop: word;
  FSaveDialog: TSaveDialog;
  Cols:TStringList;
begin
  if ADg.DataSource.DataSet.IsEmpty then
  begin
    Application.MessageBox( PChar( '没有可导出的数据。' ), PChar( '提示' ), MB_OK +
      MB_ICONINFORMATION );
    Exit;
  end;
  try
    FSaveDialog := TSaveDialog.Create( Self );
    FSaveDialog.Filter :=
      'Excel 文档 (*.xls)|*.XLS|Text files (*.txt)|*.TXT|Comma separated values (*.csv)|*.CSV|HTML file (*.htm)|*.HTM|Word 文档 (*.rtf)|*.RTF';
    if FSaveDialog.Execute and ( trim( FSaveDialog.FileName ) <> '' ) then
    begin
      try
        xlApp := CreateOleObject( 'Excel.Application' );
        xlSheet := xlApp.WorkBooks.Add;
      except
        Application.MessageBox( PChar( '无法调用Excel' ), PChar( '错误' ), MB_OK +
          MB_ICONSTOP );
        Exit;
      end;
      Cols:=TStringList.Create;
      //   表格标题
      for iLoop := 0 to ADg.Columns.Count - 1 do
      begin
        xlSheet.WorkSheets[1].Cells[1, iLoop + 1] :=
          ADg.Columns[iLoop].Title.Caption;
        Cols.Add(ADg.Columns.Items[iLoop].FieldName);
      end;
      // 数据
      ARow := 2;
      with ADg.DataSource.DataSet do
      begin
        DisableControls;
        First;
        while not Eof do
        begin
          for iLoop := 0 to Fields.Count - 1 do
          begin
            if Cols.IndexOf(Fields[iLoop].FieldName)<>-1 then
            xlSheet.WorkSheets[1].Cells[ARow,Cols.IndexOf(Fields[iLoop].FieldName)+1] :=  Fields[iLoop].Value;
//            xlSheet.WorkSheets[1].Cells[ARow, iLoop + 1] :=  Fields[iLoop].Value;
          end;
          inc( ARow );
          Next;
        end;
        First;
        EnableControls;

      end;

      FreeAndNil(Cols);

      try
        xlSheet.SaveAs( trim( FSaveDialog.FileName ) );
        Application.MessageBox( '导出完毕!', '提示', MB_IconExclamation );
      finally
        //        xlSheet.Close;
        xlApp.Visible := False;
        xlApp.Quit;
        xlApp := UnAssigned;
      end;
    end;
    FSaveDialog.Destroy;
  except
    on e: exception do
      Application.MessageBox( PChar( e.message ), '错误', MB_OK + MB_ICONSTOP );
  end;
end;

-------------------

一个更加通用的思路：AdoQueryToExcel