将数据集(TDataSet)中的数据保存成为Excel文件

来源:互联网 发布:php插件下载 编辑:程序博客网 时间:2024/05/22 15:38

/*******************************************************************************
 * 函数名: ExportDataToExcel
 * 输入参数:   ado  //pointer of TADOQuery
 *             dia  //pointer of TSaveDialog
 *             grid //pointer of TDBGrid
 *             k    //y coordiate of cells
 *             Str  //title of Excel table
 * 输出参数: None
 * 返回值: void
 * 描述:
 *******************************************************************************/
void ExportDataToExcel(TADOQuery *ado, TSaveDialog *dia, TDBGrid *grid, int k, char* Str)
{
  Variant ex, newxls, cellms;
  AnsiString sFileName;
  int row, i, j = 1;

  if (dia->Execute())
  {
    try
    {
      ex = CreateOleObject("Excel.Application");//启动Excel
      ex.OlePropertySet("Visible", (Variant)false);//使Excel不可见
      newxls = (ex.OlePropertyGet("Workbooks")).OleFunction("Add");//添加一个工作薄
      cellms = newxls.OlePropertyGet("ActiveSheet"); //创建工作区
    }

    catch (...)
    {
      ShowMessage("无法启动Excel");
      return;
    }

    ado->Active = true;
    ado->First();

    row = 1;//在第一行显示标题
    //ex.OlePropertyGet("Cells", 1, 6).OlePropertySet("Value", );
    ex.OlePropertyGet("Cells", 1, k).OlePropertySet("Value", Str);
    cellms = ex.Exec(PropertyGet("Range") << ("A" + IntToStr(row) + ":A" + IntToStr(row)));

    for (i = 0; i < ado->FieldCount; i++)
    {
      //将字段名写到工作薄的第二行
      cellms.OlePropertyGet("Cells", 2, i + 1).OlePropertySet("Value", (WideString)grid->Columns->Items[i]->Title->Caption.c_str());
      //cellms.OlePropertyGet("Cells", 2, i + 1).OlePropertySet("Value", (WideString)ado->Fields->Fields[i]->FieldName);
    }

    while (!ado->Eof)//将数据库中的记录依次写到Excel中
    {
      j = j + 1;

      for (i = 0; i < ado->FieldCount; i++)
      {
        cellms.OlePropertyGet("Cells", j + 1, i + 1).OlePropertySet("Value",(WideString)ado->Fields->Fields[i]->AsString);
      }
     ado->Next();
    }

    sFileName = dia->FileName;
    newxls.OleProcedure("SaveAs", sFileName.c_str()); //保存Excel文件

    ex.OleFunction("Quit");//退出Excel
    ex = Unassigned;
    newxls = Unassigned;
    cellms = Unassigned;
  }
}

//****得到要保存的 EXCEL 文件名******//
function GetSavedFileName : string;
var
  SD1:TSaveDialog;
begin
  SD1 := TSaveDialog.Create(nil);
  SD1.Filter := '*.csv|*.csv';
  SD1.DefaultExt := '*.csv';
  Result := '';
 if SD1.Execute then
 begin
    if FileExists(SD1.FileName) then
    begin
      if (MessageDlg('文件'+SD1.FileName+'已存在,要覆盖吗?',mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
        DeleteFile(SD1.FileName)
      else
        Exit;
    end;
    Result := SD1.FileName;
  end;
end;


// **** DBGrid 的数据输出到 EXCEL 文件中 ******** //
procedure DBGridToExcel(DBGrid: TDBGrid; FileName: string);
var
  CSV, DBRow: TStringList;
  I, J: Integer;
  DS: TDataSet;
  FieldName: string;
begin
  if FileName = '' then exit;
  CSV := TStringList.Create;
  try
    DBRow := TStringList.Create;
    try
      { 添加标题 }
      for I := 0 to DBGrid.Columns.Count-1 do
      begin
        DBRow.Add(DBGrid.Columns[I].Title.Caption);
      end;
      CSV.Add(DBRow.CommaText);
      { 添加内容 }
      DS := DBGrid.DataSource.DataSet;
      if DS.Active then
      begin
        DS.DisableControls;
        try
          J := DS.RecNo;
          DS.First;
          while not DS.Eof do
          begin
            DBRow.Clear;
            for I := 0 to DBGrid.Columns.Count-1 do
            begin
              FieldName := DBGrid.Columns[I].FieldName;
              with DS.FieldByName(FieldName) do
              begin
                case DataType of
                  ftString: DBRow.Add(AsString);
                  ftDateTime: DBRow.Add(FormatDateTime(DATETIME, AsDateTime));
                  ftCurrency, ftBCD: DBRow.Add(CurrToStr(AsCurrency));
                  ftFloat: DBRow.Add(FloatToStr(AsFloat));
                  ftInteger: DBRow.Add(IntToStr(AsInteger));
                end;
              end;
            end;
            CSV.Add(DBRow.CommaText);
            DS.Next;
          end;

          DS.RecNo := J;
        finally
          DS.EnableControls;
        end;
      end;

      CSV.SaveToFile(FileName);
    finally
      DBRow.Free;
    end;
  finally
    CSV.Free;
  end;
end;

原创粉丝点击