如何将数据库内的数据导出生成Excel文件

Question

请问哪位能指教一下，如何将数据库中的数据导出生成一个Excel文件!十分紧急，请赐教！

Answer 1

dbgrid里的内容导入到excel文件================================================
function ProgressBarform(max:integer):tProgressBar;
var
  ProgressBar1:tProgressBar;
  form:tform;
begin
  application.CreateForm(tform,form);
  form.Position:=poScreenCenter;
  form.BorderStyle:=bsnone;
  form.Height:=30;
  form.Width:=260;
  ProgressBar1:=tProgressBar.Create(form);
  ProgressBar1.Smooth:=true;
  ProgressBar1.Max:=max;
  ProgressBar1.Parent:=form;
  ProgressBar1.Height:=20;
  ProgressBar1.Width:=250;
  ProgressBar1.Left:=5;
  ProgressBar1.Top:=5;
  ProgressBar1.Step:=1;
  form.Show;
  result:=ProgressBar1;
end;
function ExportToExcel(dbgrid:tdbgrid):boolean;
const
  xlNormal=-4143;
var
  i,j,k:integer;
  str,filename:string;
  excel:OleVariant;
  SavePlace: TBook;
  savedialog:tsavedialog;
  ProgressBar1:TProgressBar;
begin
  result:=false;
  filename:='';
  if dbgrid.DataSource.DataSet.RecordCount>65536 then
     begin
       if application.messagebox('需要导出的数据过大，Excel最大只能容纳65536行,是否还要继续？','询问',mb_yesno+mb_iconquestion)=idno then
          exit;
     end;
  screen.Cursor:=crHourGlass;
  try
    excel:=CreateOleObject('Excel.Application');
    excel.workbooks.add;
  except
     screen.cursor:=crDefault;
    showmessage('无法调用Excel！');
    exit;
  end;
  savedialog:=tsavedialog.Create(nil);
  savedialog.Filter:='Excel文件(*.xls)|*.xls';
  if savedialog.Execute then
     begin
       if FileExists(savedialog.FileName) then
          try
            if application.messagebox('该文件已经存在，要覆盖吗？','询问',mb_yesno+mb_iconquestion)=idyes then
               DeleteFile(PChar(savedialog.FileName))
            else
               begin
                 Excel.Quit;
                 savedialog.free;
                  screen.cursor:=crDefault;
                 Exit;
               end;
          except
            Excel.Quit;
            savedialog.free;
             screen.cursor:=crDefault;
            Exit;
          end;
       filename:=savedialog.FileName;
     end;
  savedialog.free;
  if filename='' then
     begin
       result:=true;
       Excel.Quit;
       screen.cursor:=crDefault;
       exit;
     end;
  k:=0;
  for i:=0 to dbgrid.Columns.count-1 do
    begin
      if dbgrid.Columns.Items[i].Visible then
         begin
           //Excel.Columns[k+1].ColumnWidth:=dbgrid.Columns.Items[i].Title.Column.Width;
           excel.cells[1,k+1]:=dbgrid.Columns.Items[i].Title.Caption;
           inc(k);
         end;
    end;  dbgrid.DataSource.DataSet.DisableControls;
  saveplace:=dbgrid.DataSource.DataSet.GetBook;
  dbgrid.DataSource.dataset.First;
  i:=2;
  if dbgrid.DataSource.DataSet.recordcount>65536 then
     ProgressBar1:=ProgressBarform(65536)
  else
     ProgressBar1:=ProgressBarform(dbgrid.DataSource.DataSet.recordcount);
  while not dbgrid.DataSource.dataset.Eof do
    begin
      k:=0;
      for j:=0 to dbgrid.Columns.count-1 do
        begin
          if dbgrid.Columns.Items[j].Visible then
             begin
               excel.cells[i,k+1].NumberFormat:='@';
               if not dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).isnull then
                  begin
                    str:=dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).value;
                    Excel.Cells[i, k + 1] := Str;
                  end;
               inc(k);
             end
          else
             continue;
        end;
      if i=65536 then
         break;
      inc(i);
      ProgressBar1.StepBy(1);
      dbgrid.DataSource.dataset.next;
    end;
  progressbar1.Parent.Free;  dbgrid.DataSource.dataset.GotoBook(SavePlace);
  dbgrid.DataSource.dataset.EnableControls;  try
    if copy(FileName,length(FileName)-3,4)<>'.xls' then
       FileName:=FileName+'.xls';
    Excel.ActiveWorkbook.SaveAs(FileName, xlNormal, '', '', False, False);
  except
    Excel.Quit;
     screen.cursor:=crDefault;
    exit;
  end;
  Excel.Visible := true;
  screen.cursor:=crDefault;
  Result := true;
end;记得带上这些单元
uses
  Windows,Graphics,DB,Grids, DBGrids,StdCtrls,forms,Sysutils,classes,
  Controls,comobj,comctrls,Dialogs;

Answer 2

显示到 DbGridEh 中 ：uses DBGridEhImpExp ;    SaveDBGridEhToExportFile(TDBGridEhExportAsXLS, DBGridEh1, SaveDialog1.FileName, True);可以将 DbGridEh 中的数据导入到 Excel 或者 Txt中

Answer 3

unit main;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Db, ADODB, ComCtrls, ComObj, OleCtnrs, ExtCtrls, Mask;type
  TfrmMain = class(TForm)
    ADOConnection1: TADOConnection;
    OpenDialog1: TOpenDialog;
    StatusBar1: TStatusBar;
    ADOQuery1: TADOQuery;
    ProgressBar1: TProgressBar;
    OleContainer1: TOleContainer;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    CheckBox1: TCheckBox;
    Edit1: TEdit;
    Bevel1: TBevel;
    Label2: TLabel;
    Edit2: TEdit;
    Bevel2: TBevel;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    lb1: TLabel;
    lb2: TLabel;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
    PR_DbString:String; //ADO连接字符串
    PR_DbPath:String;   //数据库路径
    PR_ExePath:String;
    //function WordToTxt(paField:TField; paWordApp,paWordDoc:OleVariant; paExePath:String):String;
    function WordToTxt(paField:TField; paExePath:String):String;
  public
    { Public declarations }
  end;var
  frmMain: TfrmMain;implementation{$R *.DFM}//*** 把Word文件转换为Txt文件 ***//
//function TfrmMain.WordToTxt(paField:TField; paWordApp,paWordDoc:OleVariant; paExePath:String):String;
function TfrmMain.WordToTxt(paField:TField;paExePath:String):String;
var
  //ms:TMemorystream;
  fs:TFileStream;
  vWordFile,vTxtFile,vFileType:OleVariant;
  vTempFile,vTempTxt:String;
  //TxtFile:String;
  F:TextFile;
  S:String;
  WordApp,MyWordDoc:OleVariant;
begin
  result:='';
  vWordFile:=paExePath+'word.doc';
  vTempTxt:=paExePath+'excel.txt';
  vTxtFile:=paExePath+'excel.txt';
  vFileType:=4;
  vTempFile:=paExePath+'temp.fsr';  try
    WordApp:=CreateOleObject('Word.Application');
    MyWordDoc:=CreateOleObject('Word.Document');
    //MyWordDoc:=WordApp.Documents.Add();
  except
    ShowMessage('无法建立Word对象!!!');
    //result:='Error';
    Exit;
  end;  try
    fs:=TFileStream.Create(vTempFile,fmCreate);
    try
      TBlobField(paField).SaveToStream(fs);
      fs.Free;
      OleContainer1.LoadFromFile(vTempFile);
      Olecontainer1.SaveAsDocument(vWordFile);
      //paWordDoc.Clear;
      //paWordDoc:=paWordApp.Documents.Add(vWordFile,False);
      MyWordDoc:=WordApp.Documents.Add(vWordFile,False);
      MyWordDoc.SaveAs(vTxtFile,4);
      //paWordDoc.SaveAs(vTxtFile,4);
    except
      ShowMessage('转换Word为Txt时发生错误!!!');
      Exit;
    end;
  finally
    MyWordDoc.Close;
    WordApp.Quit;
    WordApp:=Unassigned;
  end;  try
    //*** read Txt Files
    AssignFile(F,vTempTxt);
    Reset(F);
    //while not Eof(F) do
    //begin
      Read(F,S);
    //  Readln;
    //end;
    CloseFile(F);
    result:=S;
  except
    ShowMessage('读取Txt时发生错误!!!');
    Exit;
  end;
end;//*** Open Access ***//
procedure TfrmMain.Button1Click(Sender: TObject);
var
  vPw:String;
begin
  if CheckBox1.Checked then
  begin
    if Edit1.Text = '' then
    begin
      ShowMessage('请填入数据库密码!!!');
      Edit1.SetFocus;
      Exit;
    end
    else
      vPw:=Edit1.Text;
  end
  else
    vPw:='""';  if OpenDialog1.Execute then
  begin
    PR_DbPath:=Opendialog1.FileName;
    PR_DbString:='Provider=Microsoft.Jet.OLEDB.4.0;'+
           'User ID=Admin;Data Source=' + PR_DbPath + ';'+
           'Mode=Share Deny None;Extended Properties="";'+
           'Locale Identifier=2052;Persist Security Info=False;'+
           'Jet OLEDB:System database="";Jet OLEDB:Registry Path="";'+
           'Jet OLEDB:Database Password=' + vPw + ';'+
           'Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;'+
           'Jet OLEDB:Global Partial Bulk Ops=2;'+
           'Jet OLEDB:Global Bulk Transactions=1;'+
           'Jet OLEDB:New Database Password="";'+
           'Jet OLEDB:Create System Database=False;'+
           'Jet OLEDB:Encrypt Database=False;'+
           'Jet OLEDB:Don''t Copy Locale on Compact=False;'+
           'Jet OLEDB:Compact Without Replica Repair=False;'+
           'Jet OLEDB:SFP=False';
    //'Provider=Microsoft.Jet.OLEDB.4.0;'+
    //             'Password=' + vPw +';' +
    //             'Data Source=' + PR_DbPath +
    //             ';Persist Security Info=False';
    try
      if ADOConnection1.Connected = True then
        ADOConnection1.connected:=False;
      ADOConnection1.ConnectionString:=PR_DbString;
      ADOConnection1.Connected:=True;
      //ShowMessage('Connection is OK!!!');
      StatusBar1.SimpleText:='已连接 '+PR_DbPath;
    except
      StatusBar1.SimpleText:='';
      ShowMessage('Connection is Error!!!');
    end;
  end;
end;//*** Access-Excel ***//
procedure TfrmMain.Button2Click(Sender: TObject);
var
  ExcelApp,MyExcelSheet: OleVariant;
  //WordApp,MyWordDoc: OleVariant;
  vExcelFile: OleVariant;
  icount:Integer;
  i:Integer;
  vTableName:String;
begin
  if Edit2.Text = '' then
  begin
    ShowMessage('请填入数据库表名称!!!');
    Edit2.SetFocus;
    Exit;
  end
  else
    vTableName:=Edit2.Text;  if ADOConnection1.Connected = False then
  begin
    ShowMessage('请先连接数据库!!!');
    Exit;
  end;  try
    ExcelApp:=CreateOleObject('Excel.Application');
    MyExcelSheet:=CreateOleObject('Excel.Sheet');
    MyExcelSheet:=ExcelApp.WorkBooks.Add;
  except
    ShowMessage('无法建立Excel对象!!!');
    Exit;
  end;

Answer 4

{try
    WordApp:=CreateOleObject('Word.Application');
    MyWordDoc:=CreateOleObject('Word.Document');
    //MyWordDoc:=WordApp.Documents.Add();
  except
    ShowMessage('无法建立Word对象!!!');
    Exit;
  end;}  try
    Button1.Enabled:=False;
    Button2.Enabled:=False;
    StatusBar1.SimpleText:='正在准备转换数据!!!';
    try
      with ADOQuery1 do
      begin
        Close;
        SQL.Clear;
        SQL.Add('select * from '+vTableName);
        Open;
      end;
      icount:=ADOQuery1.RecordCount;
    except
      ShowMessage('没有找到对应的数据表!!!');
      Exit;
    end;
    if icount > 0 then
    begin
      lb1.Caption:=IntToStr(icount);
      StatusBar1.SimpleText:='正在转换数据...... 请勿中断!!!!!!';
      ADOQuery1.First;
      while not ADOQuery1.Eof do
      begin
        for i := 0 to ADOQuery1.FieldCount - 1 do
        begin
          if ADOQuery1.RecNo = 1 then
            MyExcelSheet.WorkSheets[1].Cells[1,i+1].Value:=
            ADOQuery1.FieldList[i].DisplayName;
          //if (not ADOQuery1.FieldList[i].IsNull) and (i < 5) then
          if not ADOQuery1.FieldList[i].IsNull then
            if not ADOQuery1.FieldList[i].IsBlob then
              MyExcelSheet.WorkSheets[1].Cells[ADOQuery1.RecNo+1,i+1].Value:=
              ADOQuery1.FieldList[i].Value
            else
            begin
              MyExcelSheet.WorkSheets[1].Cells[ADOQuery1.RecNo+1,i+1].Value:=
              WordToTxt(ADOQuery1.FieldList[i],PR_ExePath);
            end;
        end;
        lb2.Caption:=IntToStr(ADOQuery1.RecNo);
        ProgressBar1.Position:=Trunc((ADOQuery1.RecNo/icount)*100);
        Application.ProcessMessages;
        ADOQuery1.Next;
      end;
      ShowMessage('转换完毕!!!');
      //MyExcelSheet.SaveAs('d:\1.xls');
      if SaveDialog1.Execute then
      begin
        vExcelFile:=SaveDialog1.FileName + '.xls';
        MyExcelSheet.SaveAs(vExcelFile);
      end
      else
      begin
        ShowMessage('无法打开保存对话框!!!');
        Exit;
      end;
    end
    else
    begin
      ShowMessage('数据表中无数据!!!');
      Exit;
    end;
  finally
    MyExcelSheet.Close;
    ExcelApp.Quit;
    ExcelApp:=Unassigned; //释放Excel临时文件    //MyWordDoc.Close;
    //WordApp.Quit;
    //WordApp:=Unassigned;
    Button1.Enabled:=True;
    Button2.Enabled:=True;
    lb1.Caption:='';
    lb2.Caption:='';
    StatusBar1.SimpleText:='已连接 '+PR_DbPath;
    ProgressBar1.Position:=0;
  end;
end;procedure TfrmMain.FormShow(Sender: TObject);
begin
  Edit1.PasswordChar:='*';
  Edit1.Enabled:=False;
end;procedure TfrmMain.FormCreate(Sender: TObject);
begin
  PR_ExePath:=ExtractFilePath(Application.ExeName);
  if PR_ExePath[Length(PR_ExePath)] <> '\' then
    PR_ExePath:=PR_ExePath + '\';
end;procedure TfrmMain.CheckBox1Click(Sender: TObject);
begin
  with Sender as TCheckBox do
  begin
    if Checked = True then
    begin
      Edit1.Enabled:=True;
      Edit1.Text:='';
      Edit1.SetFocus;
    end
    else
    begin
      Edit1.Text:='';
      Edit1.Enabled:=False;
    end;
  end;
end;end.

Answer 5

我这儿也有一段代码：
unit dbgrid_xls;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,comobj, Grids, DBGrids, Excel2000, OleServer;type
  Twh_dbgrid_xls = class(TForm)
    DBGrid1: TDBGrid;
    ExcelApplication1: TExcelApplication;
    ExcelWorksheet1: TExcelWorksheet;
  private
    { Private declarations }  public
    { Public declarations }
    procedure CopyDbDataToExcel(Target: TDbgrid;mc:string);
  end;var
  wh_dbgrid_xls: Twh_dbgrid_xls;
implementation{$R *.dfm}
procedure Twh_dbgrid_xls.CopyDbDataToExcel(Target: TDbgrid;mc:string);
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');
except
Screen.Cursor := crDefault;
Exit;
end;
XLApp.WorkBooks.Add[XLWBatWorksheet];
XLApp.WorkBooks[1].WorkSheets[1].Name := 'Sheet1';
Sheet := XLApp.Workbooks[1].WorkSheets['Sheet1'];
if not Target.DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
Target.DataSource.DataSet.first;
Sheet.cells[1,5]:=mc;
XLApp.ActiveSheet.Rows[1].Font.Name := '宋体';
XLApp.ActiveSheet.Rows[1].Font.size := '12';
XLApp.ActiveSheet.Rows[1].Font.Color := clBlack;
XLApp.ActiveSheet.Rows[1].Font.Bold := False;
for iCount := 0 to Target.Columns.Count - 1 do
begin
Sheet.cells[1,iCount+1]:=Target.Columns[iCount].Title.Caption;
Sheet.cells[2,iCount + 1] := Target.Columns.Items[iCount].Title.Caption;
end;
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.Columns.Items[iCount].Field.AsString;
end;
Inc(jCount);
Target.DataSource.DataSet.Next;
end;
XlApp.Visible := True;
Screen.Cursor := crDefault;
end;
end.

Answer 6

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, Grids, DBGrids, ADODB, StdCtrls, OleServer, Excel2000,comobj;type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ADOConnection1: TADOConnection;
    ADOTable1: TADOTable;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    ExcelApplication1: TExcelApplication;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation
{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var
    v : variant;
    s : string;
    i,j : integer;
begin
  s:='e:\tan.xls'; //文件名
  if fileexists(s) then deletefile(s);
  v:=CreateOLEObject('Excel.Application'); //建立OLE对象
  V.WorkBooks.Add;
  if Checkbox1.Checked then
    begin
      V.Visible:=True;
      form1.WindowState:=wsMinimized;       //使Excel可见，并将本程序最小化，以观察Excel的运行情况
    end
  else
    begin
      V.Visible:=False;
    end;
    //使Excel窗口不可见
    Application.BringToFront; //程序前置
    try
    try
    Cursor:=crSQLWait;
    adoTable1.DisableControls;
    For i:=0 to adoTable1.FieldCount-1 do //字段数
    //注意：Delphi中的数组的下标是从0开始的，
    // 而Excel的表格是从1开始编号
    begin
      V.Goto('R1'+'C'+IntToStr(i+1)); //Excel的表格是从1开始编号
      V.ActiveCell.FormulaR1C1:=adoTable1.Fields[i].FieldName;//传送字段名
    end;
    j:=2;
    adoTable1.First;
    while not adoTable1.EOF do
    begin
      For i:=0 to adoTable1.FieldCount-1 do //字段数
      begin
        V.Goto('R'+IntToStr(j)+'C'+IntToStr(i+1));
        V.ActiveCell.FormulaR1C1:=adoTable1.Fields[i].AsString;//传送内容
    end;
    adoTable1.Next;
    j:=j+1;
    end;
    V.ActiveSheet.Protect(DrawingObjects:=True, Contents:=True, Scenarios:=True);//设置保护
    ShowMessage('数据库到Excel的数据传输完毕!');
    v.ActiveWorkBook.Saveas(filename:=s);//文件存盘
    except //发生错误时
    ShowMessage('没有发现Excel!');
    end;
    finally
    Cursor:=crDefault;
    adoTable1.First;
    adoTable1.EnableControls;
    v.quit; //退出OLE对象
    form1.WindowState:=wsNormal;
    end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  close;
end;procedure TForm1.FormShow(Sender: TObject);
begin
   adoTable1.Open;
end;end.