有关dbgrid导出到excel的问题

Question

下面是一段从dbgrid中倒出数据到excel的代码，请问一下我如何才能把在内存中生成的excel文件保存到硬盘上？？谢谢~~~ 我不知道该怎么写procedure Tmainform.CopyDbDataToExcel(Target: Tiwdbgrid);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;begin
//Screen.Cursor := crHourGlass;
//if not VarIsEmpty(XLApp) then
//begin
//XLApp.DisplayAlerts := False;
//XLApp.Quit;
//VarClear(XLApp);
//end;
//通过ole创建Excel对象
try
XLApp := CreateOleObject('Excel.Application');
exceptExit;
end;
XLApp.WorkBooks.Add[XLWBatWorksheet];
XLApp.WorkBooks[1].WorkSheets[1].Name := 'web';
Sheet := XLApp.Workbooks[1].WorkSheets['web'];if not Target.DataSource.DataSet.Active then
beginExit;
end;Target.datasource.DataSet.first;for iCount := 0 to Target.Columns.Count - 1 do
begin
Sheet.cells[1, iCount + 1] := Target.Columns.Items[icount].DisplayName;
end;                          //Target.Columns.Items[iCount].Title.Caption;
jCount := 1;
while not Target.DataSource.DataSet.Eof do
begin
for iCount := 0 to Target.Columns.Count - 1 do
begin
Sheet.cells[jCount + 1, iCount + 1] :=target.DataSource.DataSet.FieldByName(Target.Columns.Items[icount].DisplayName).AsString;
end;                                   //Target.Columns.Items[iCount].Field.AsString
Inc(jCount);
Target.DataSource.DataSet.Next;
end;
XlApp.Visible := True;
end;

Answer 1

直接导顾EXCEL不就可以了吗？
EXEC master..xp_cmdshell 'bcp SettleDB.dbo.shanghu out c:\temp1.xls -c -q -S"GNETDATA/GNETDATA" -U"sa" -P""'

Answer 2

或者，试试这个函数
function ExportToExcel(Header: String;
  vDataSet: TDataSet): Boolean;
var
  I,VL_I,j: integer;
  S,SysPath: string;
  MsExcel:Variant;
begin
  Result:=true;
  if Application.MessageBox('您确信将数据导入到Excel吗?','提示！',MB_OKCANCEL + MB_DEFBUTTON1) = IDOK then
  begin
      SysPath:=ExtractFilePath(application.exename);
      with TStringList.Create do
      try
        vDataSet.First ;
        S:=S+Header;
    //    system.Delete(s,1,1);
        add(s);
        s:='';
        For I:=0 to vDataSet.fieldcount-1 do
          begin
            If vDataSet.fields[I].visible=true then
               S:=S+#9+vDataSet.fields[I].displaylabel;
          end;
        system.Delete(s,1,1);
        add(s);
        while not vDataSet.Eof do
        begin
          S := '';
          for I := 0 to vDataSet.FieldCount -1 do
            begin
              If vDataSet.fields[I].visible=true then
                 S := S + #9 + vDataSet.Fields[I].AsString;
            end;
          System.Delete(S, 1, 1);
          Add(S);
          vDataSet.Next;
        end;
        Try
          SaveToFile(SysPath+'\Tem.xls');
        Except
          ShowMessage('写文件时发生保护性错误，Excel 如在运行，请先关闭！');
          Result:=false;
          exit;
        end;
      finally
        Free;
      end;
      Try
        MSExcel:=CreateOleObject('Excel.Application');
      Except
        ShowMessage('Excel 没有安装，请先安装！');
        Result:=false;
        exit;
      end;
      Try
        MSExcel.workbooks.open(SysPath+'\Tem.xls');
      Except
        ShowMessage('打开临时文件时出错，请检查'+SysPath+'\Tem.xls');
        Result:=false;
        exit;
      end;
        MSExcel.visible:=True;
        for VL_I :=1 to 4 do
        MSExcel.Selection.Borders[VL_I].LineStyle := 0;
        MSExcel.cells.select;
        MSExcel.Selection.HorizontalAlignment :=3;
        MSExcel.Selection.Borders[1].LineStyle := 0;      MSExcel.Range['A1'].Select;
      MSExcel.Selection.Font.Size :=24;      J:=0 ;
      for i:=0 to vdataset.fieldcount-1 do
          if vDataSet.fields[I].visible  then
             J:=J+1;      VL_I :=J;
      MSExcel.Range['A1:'+F_ColumnName(VL_I)+'1'].Select;
      MSExcel.Range['A1:'+F_ColumnName(VL_I)+'1'].Merge;
  end
  else
    Result:=false;
end;

Answer 3

這個函數放到你的程序裏面就可以用了，非常方便，只要輸入參數，dbgrid的名字即可
PROCEDURE TGCFP.KIT_DBGRID_TO_EXCEL(SRC_DBG:TDBGRID);
VAR
   EXCEL:VARIANT;
   EXCEL_WORKBOOK:VARIANT;
   EXCEL_WORKSHEET:VARIANT;
   OPENDIALOG1:TOPENDIALOG;
   I,J:INTEGER;
   CUR_DIR:STRING;
BEGIN
TRY
{   SRC_DBG;
   SRC_DBG.DATASOURCE.DATASET;
}
   WITH SRC_DBG.DATASOURCE.DATASET DO
   IF (BOF AND EOF) THEN
       EXIT;
  IF (SRC_DBG.DATASOURCE.DATASET.STATE=DSEDIT) OR (SRC_DBG.DATASOURCE.DATASET.STATE=DSINSERT) THEN
      BEGIN
          SHOWMESSAGE('數據表格處於編輯或新增記錄狀態,請保存或取消修改後重試一次');
          EXIT;
      END;
  TRY
   EXCEL:= CREATEOLEOBJECT('EXCEL.APPLICATION');
   EXCEPT
     SHOWMESSAGE('EXCEL MAY NOT BE INSTALLED');
     ABORT;
     EXIT;
   END;   OPENDIALOG1:=TOPENDIALOG.CREATE(SELF);
   OPENDIALOG1.DEFAULTEXT := 'XLS';
   OPENDIALOG1.FILTER := '*.XLS';
   GETDIR(0,CUR_DIR);
   OPENDIALOG1.INITIALDIR := CUR_DIR;   IF OPENDIALOG1.EXECUTE THEN
      BEGIN
      IF FILEEXISTS(OPENDIALOG1.FILENAME) THEN
         BEGIN
            IF MESSAGEDLG('本程序固定將表格內容寫入所選EXCEL文件的左上方,視表格內容定佔用篇幅,如果你的EXCEL文件該區已有內容,則會被覆寫,要繼續嗎?',MTCONFIRMATION, [ MBNO,MBYES], 0) = MRNO THEN
            EXIT;
            EXCEL.WORKBOOKS.OPEN(OPENDIALOG1.FILENAME);
         END
      ELSE
         EXCEL.WORKBOOKS.ADD(1);
      END
   ELSE
      BEGIN
         SHOWMESSAGE('未指定要保存的文件名,退出....');
         EXIT;
      END;
   EXCEL_WORKBOOK :=EXCEL.APPLICATION.WORKBOOKS[1];
   EXCEL_WORKSHEET :=EXCEL_WORKBOOK.WORKSHEETS[1];  FOR I:=0 TO SRC_DBG.COLUMNS.COUNT-1 DO
      BEGIN
        EXCEL_WORKSHEET.CELLS.ITEM[1,I+1]:=SRC_DBG.COLUMNS[I].TITLE.CAPTION;
      END;
  J:=2;
  WITH SRC_DBG.DATASOURCE.DATASET DO
  BEGIN
    DISABLECONTROLS;
    FIRST;
    WHILE NOT  EOF DO
     BEGIN
       FOR  I:=0 TO SRC_DBG.COLUMNS.COUNT-1 DO
         BEGIN
              EXCEL_WORKSHEET.CELLS.ITEM[J,I+1]:= TRIM(FIELDBYNAME(SRC_DBG.COLUMNS[I].FIELDNAME).ASSTRING);
         END;
       NEXT;
       J:=J+1;
     END;
    ENABLECONTROLS;
  END;
   EXCEL_WORKBOOK.SAVEAS(OPENDIALOG1.FILENAME);
   EXCEL.APPLICATION.QUIT;
   SHOWMESSAGE('成功保存到文件 : '+ OPENDIALOG1.FILENAME );
   OPENDIALOG1.FREE;
EXCEPT
   OPENDIALOG1.FREE;
   SRC_DBG.DATASOURCE.DATASET.ENABLECONTROLS;
   EXCEL.APPLICATION.QUIT;
   EXCEL_WORKSHEET.FREE;
   EXCEL_WORKBOOK.FREE;
   EXCEL.FREE;
   SHOWMESSAGE('保存失敗,請確認該文件是否處於打開狀態!確認將其關閉後再試一次!');
   END;
END;

Answer 4

推荐楼主用 Developer Express Inc的控件，有一个和dbgrid一样用但比它强大的叫dxdbgrid的东西。直接用其  sendtoexcel('文件名') 就能达到目的，还可以自动生成html格式的表格等等等等。那个函数名好象叫sendtoexcel，忘了叫什么了呵呵，反正就这么一句就搞定了。可以直接用dxdbgrid替换delphi的dbgrid，只要名字改成原来一样的，照样编译通过。

Answer 5

我做得Excel接口，希望大家指点
unit ExcelInterface;interface
  uses Windows, SysUtils, Dialogs, ComObj, StdCtrls, OleServer, Excel97,
    Variants;type
  TExcelInterface = class
  private
    Cell1, Cell2, Range1: Variant;
    WorkBook, WorkSheet: Variant;
    FSheetCount: Integer;
    procedure SetSheetCount(const Value: Integer);
  public
    exlApp: Variant;
    property SheetCount: Integer read FSheetCount write SetSheetCount;
    function CreateExcel: Boolean;
    procedure OpenExcel(AFileName: String);
    procedure SaveExcel(AFileName: String);
    procedure NewWorkBook();
    procedure NewSheet(ASheetName: String);
    procedure DeleteSheet(ASheetIndex: Integer);overload;
    procedure DeleteSheet(ASheetName: String);overload;
    procedure SetContent(ACol,ARow: Integer;AText: String);
    procedure SetActiveSheet(ASheetName: String);
    procedure MergeCells(FirstRow,LastRow,FirstCol,LastCol: Integer);overload;
    procedure MergeCells(ARange: Variant);overload;
    procedure MergeCells;overload;
    procedure SetRange(FirstRow,LastRow,FirstCol,LastCol: Integer);
    procedure SetRowHeight(ARow: Integer;AHeight: Real);
    procedure SetAlignment(HAlignment,VAlignment: LongInt);
    procedure SetFont(Style:String; Size: Integer; Color: COLORREF;Bold: Boolean);
    procedure SetRangeFormat(WrapText,AddIndent,ShrinkToFit: Boolean;Orientation: Integer);
    procedure Free;overload;
  end;
implementation{ TExcelInterface }function TExcelInterface.CreateExcel: Boolean;
begin
  try
    exlApp := CreateOleObject('Excel.Application');
    WorkBook := CreateOleObject('Excel.Sheet');
    WorkSheet := CreateOleObject('Excel.Sheet');
  except
    ShowMessage('您没有安装Microsoft Excel');
    Result := False;
    Exit;
  end;
  Result := True;
end;procedure TExcelInterface.DeleteSheet(ASheetIndex: Integer);
begin
  WorkBook.Sheets[ASheetIndex].Delete;
  SetSheetCount(exlApp.Sheets.Count);
end;procedure TExcelInterface.DeleteSheet(ASheetName: String);
begin
  WorkBook.WorkSheets('"'+ASheetName+'"').Delete;
  SetSheetCount(exlApp.Sheets.Count);
end;procedure TExcelInterface.Free;
begin
  exlApp.Quit;
  inherited;
end;procedure TExcelInterface.MergeCells(FirstRow, LastRow, FirstCol,
  LastCol: Integer);
begin
  SetRange(FirstRow,LastRow,FirstCol,LastCol);
  Range1.Select;
  exlApp.Selection.MergeCells := True;
end;procedure TExcelInterface.MergeCells(ARange: Variant);
begin
  ARange.Select;
  exlApp.Selection.MergeCells := True;
end;procedure TExcelInterface.MergeCells;
begin
  Range1.Select;
  exlApp.Selection.MergeCells := True;
end;procedure TExcelInterface.NewSheet(ASheetName: String);
begin
  WorkSheet := WorkBook.WorkSheets.Add;
  WorkSheet.Name := ASheetName;
  SetSheetCount(exlApp.Sheets.Count);
end;procedure TExcelInterface.NewWorkBook();
begin
  WorkBook := exlApp.WorkBooks.Add;
  SetSheetCount(exlApp.Sheets.Count);
  exlApp.Visible := True;
end;procedure TExcelInterface.OpenExcel(AFileName: String);
begin
  WorkBook := exlApp.WorkBooks.Open(AFileName);
end;procedure TExcelInterface.SaveExcel(AFileName: String);
begin
  WorkBook.SaveAs(AFileName);
  WorkBook.Saved := True;
end;procedure TExcelInterface.SetActiveSheet(ASheetName: String);
begin
  WorkBook.WorkSheets[ASheetName].Select;
  WorkSheet := WorkBook.WorkSheets[ASheetName];
end;procedure TExcelInterface.SetAlignment(HAlignment, VAlignment: LongInt);
begin
  Range1.HorizontalAlignment := HAlignment;
  Range1.VerticalAlignment := VAlignment;
end;procedure TExcelInterface.SetFont(Style:String; Size: Integer;
  Color: COLORREF; Bold: Boolean);
begin
  Range1.Font.FontStyle := Style;
  Range1.Font.Size := Size;
  Range1.Font.Color := Color;
  Range1.Font.Bold := Bold;
end;procedure TExcelInterface.SetRange(FirstRow, LastRow, FirstCol,
  LastCol: Integer);
begin
  Cell1 := WorkSheet.Cells.Item[FirstRow,FirstCol];
  Cell2 := WorkSheet.Cells.Item[LastRow,LastCol];
  Range1 := WorkSheet.Range[Cell1,Cell2];
end;procedure TExcelInterface.SetRangeFormat(WrapText, AddIndent,
  ShrinkToFit: Boolean; Orientation: Integer);
begin
  Range1.Select;
  exlApp.Selection.WrapText := WrapText;
  exlApp.Selection.Orientation := Orientation;
  exlApp.Selection.AddIndent := AddIndent;
  exlApp.Selection.ShrinkToFit := ShrinkToFit;
end;procedure TExcelInterface.SetRowHeight(ARow: Integer; AHeight: Real);
begin
  WorkSheet.Rows[IntToStr(ARow) + ':' + IntToStr(ARow)].RowHeight := AHeight;
end;procedure TExcelInterface.SetContent(ACol, ARow: Integer; AText: String);
begin
  WorkSheet.Cells.Item[ACol,ARow] := AText;
end;procedure TExcelInterface.SetSheetCount(const Value: Integer);
begin
  FSheetCount := Value;
end;end.