Delphi Excel to Sql Server

来源:互联网 发布:淘宝助理5.7教程 编辑:程序博客网 时间:2024/06/15 19:32

 unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Grids, DBGrids, DB, ADODB,comobj, OleServer,
  ExcelXP;

type
  TForm1 = class(TForm)
    ADOConn: TADOConnection;
    atblXlsToSql: TADOTable;
    DBGrid1: TDBGrid;
    Panel1: TPanel;
    Button1: TButton;
    opdExcel: TOpenDialog;
    DataSource1: TDataSource;
    Excel: TExcelApplication;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    function ConnectDB:boolean;              //连接数据库
    function  OpenTable(const Tablename:String):boolean;   //打开指定数据表
    function  XlsToSqlTable(const xlsFileName,TableName:String):boolean;  //将Excel数据导入Sql Server
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  serverIP,dbName,userid,passw:string;  //服务器IP,数据库名称,用户名,密码

implementation

{$R *.dfm}

function TForm1.ConnectDB:boolean;
begin
  Result:=false;
  serverIP:='192.168.0.0';
  dbName:='OnLine';
  userid:='sa';
  passw:='sa';
  if not adoconn.Connected then
  begin
    adoconn.ConnectionString:='Provider=SQLOLEDB.1;Password=' + passw
                            + ';Persist Security Info=True;User ID=' + userid
                            + ';Initial Catalog=' + dbName
                            + ';Data Source=' + ServerIP;
    adoconn.LoginPrompt:=false;
    adoconn.Open();
  end;
  Result:=True;
end;


function TForm1.OpenTable(const Tablename:String):boolean;
begin
  Result:=false;
  if not adoconn.Connected then
    if not ConnectDB then
    begin
      showmessage('连接数据库失败');
      exit;
    end;

   atblXlstoSql.Connection:=adoconn;
   atblXlstoSql.TableName:=Tablename;
   try
     atblXlstoSql.Open;
   except
     ShowMessage('表名不正确或该表不存在!');
     exit;
   end;
   Result:=True;
end;


function TForm1.XlsToSqlTable(const xlsFileName,TableName:string):boolean;
var
  excelApp,workbook,sheet:variant;
  iRow:integer;
begin
  Result:=False;

  //连接数据库,打开要导入数据的表
  if not OpenTable(TableName) then
    exit;

  // 建立excel应用
  try
  begin
    excelApp:=CreateOleObject( 'Excel.Application' );
    workbook:=excelApp.workbooks.open(xlsFileName);
    sheet:=workbook.sheets[1];
  end;
  except
    showmessage('open excel file fail');
    exit;
  end;

  try
    adoconn.BeginTrans;        //事务处理
    for iRow:=2 to sheet.UsedRange.Rows.Count do        //iRow:=2 跳过标题行,sheet.UsedRange.Rows.Conut 文件的行数
    begin
      atblXlstoSql.Append;
      atblXlstoSql.FieldByName('Name').AsString:=sheet.Cells[iRow,1];
      atblXlstoSql.FieldByName('Number').AsString:=sheet.Cells[iRow,3];
      atblXlstoSql.FieldByName('Remark').AsString:=sheet.Cells[iRow,4];
    end;
    atblXlstoSql.Post;
    adoconn.CommitTrans;
    except
      adoconn.RollbackTrans;
    end;
 //   atblXlstoSql.Close;
    excelAPP.Quit;
    Result:=true;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FileName:string;
begin
  if opdExcel.Execute then
     FileName:=opdExcel.FileName
  else
     exit;
  if MessageBox(handle,'确定将Excel数据导入数据库吗?','提示',MB_OKCANCEL+MB_ICONQUESTION)=IDOK then
     if xlsToSqlTable(FileName,'bc_member') then
        MessageBox(handle,'导入完成!','提示',MB_OK+MB_ICONASTERISK)
     else
        MessageBox(handle,'导入失败!','提示',MB_OK+MB_ICONERROR)

end;

end.