excel.pas

excel导入e xcel导入e xcel导入e xcel导入

unit Excel;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SnEdit, SnButton, DB, ADODB, SnLabel, DBCtrls,
  SnDBListBox, Grids, DBGrids, SnDBGrid, SnForm, SnDBMemo, SnMemo,
  SnListBox,Comobj,Excel2000, SnProgressBar, SnCustomComboBox, SnComboBox,
  ComCtrls, SnStatusBar, ExtCtrls, Buttons, CheckLst, jpeg ,Winprocs;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    ADOConn: TADOConnection;
    ADO: TADOQuery;
    TabSheet6: TTabSheet;
    GroupBox1: TGroupBox;
    Label8: TLabel;
    Label9: TLabel;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    CheckBox2: TCheckBox;
    Label7: TLabel;
    RadioGroup1: TRadioGroup;
    ComboBox1: TComboBox;
    CheckBox1: TCheckBox;
    Label6: TLabel;
    ListBox1: TListBox;
    Label1: TLabel;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    Button5: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Edit5: TEdit;
    Edit4: TEdit;
    Edit3: TEdit;
    Edit2: TEdit;
    Label10: TLabel;
    TabSheet7: TTabSheet;
    Edit6: TEdit;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    CheckListBox1: TCheckListBox;
    Label11: TLabel;
    ProgressBar1: TProgressBar;
    Panel1: TPanel;
    Image1: TImage;
    CheckBox3: TCheckBox;
    ADOE: TADOQuery;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    procedure SpeedButton1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure ComboBox3Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
  private
    { Private declarations }
    procedure Wizard1;
    procedure Wizard2;
    procedure Wizard3;
    procedure Wizard4;
    procedure Wizard5;
    procedure Wizard6;
    procedure Success;
    procedure QuerySQL(pQuery: TADOQuery;pSql: string);
    procedure ExecSQL(pQuery: TADOQuery;pSQl: string);
  public
    { Public declarations }
    ExpExcel,WorkBook,WorkSheet: Variant;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.QuerySQL(pQuery: TADOQuery; pSql: string);
begin
   pQuery.Close;
   pQuery.SQL.Clear;
   pQuery.SQL.Add(pSql);
   try
      pQuery.Open;
   except
      application.MessageBox('查询出错','提示',64);
   end;
end;

procedure TForm1.ExecSQL(pQuery: TADOQuery;pSQL: String);
begin  
   pQuery.Close;
   pQuery.SQL.Clear;
   pQuery.SQL.Add(pSQL);
   try
      pQuery.ExecSQL;
   except
      MessageDlg(pSQL, mtWarning, [mbOK], 0);
      abort;
   end;
end;
procedure TForm1.Wizard1 ;
begin
end;
procedure TForm1.Wizard2 ;
var
   ExpExcel: Variant;
   row,i,col : integer;
begin
   if Edit1.Text='' then
      MessageDlg('请输入导入的数据源 !', mtWarning, [mbOK], 0)
   else
   begin
      try
         ExpExcel := CreateOleObject('Excel.Application');
      except
         MessageDlg('Can not creat Excel 2000 file !', mtWarning, [mbOK], 0);
         exit;
      end;
      ListBox1.Items.Clear ;
      ExpExcel.workbooks.open(Edit1.Text);
      for i:=1 to ExpExcel.worksheets.count do
      begin
         ListBox1.Items.Add('Sheet'+InttoStr(i));
      end;
      ExpExcel := null;
      ExpExcel := Unassigned;
      ListBox1.Selected[0] := true;
      PageControl1.ActivePage := Tabsheet3;
   end;
end;
procedure TForm1.Wizard3 ;
begin
   if ListBox1.ItemIndex=-1 then
      MessageDlg('请选择一个区域！',mtWarning,[mbOK],0)
   else
   begin
      PageControl1.ActivePage := Tabsheet4;
   end;
end;
procedure TForm1.Wizard4 ;
var
   sString:String;
begin
   sString :='SELECT name FROM '+trim(Edit3.Text)+'..sysobjects where xtype=''U''' ;
   QuerySQL(ADO,sString);
   ComboBox1.Items.Clear ;
   while not ADO.Eof do
   begin
      ComboBox1.Items.Add(ADO.Fields[0].AsString);
      ADO.Next;
   end;
end;
procedure TForm1.Wizard5 ;
var row,col,i,j:integer;
    s:String;
begin
    if RadioButton1.Checked then     //新建表中
    begin
       try
          ExpExcel := CreateOleObject('Excel.Application');
          WorkBook := ExpExcel.WorkBooks.Open(trim(Edit1.Text));//打开Excel文档
       except
          Application.MessageBox('Excel 文件读取失败','Error!',MB_OK);
          ExpExcel:=null;
          exit;
       end;
       row:=WorkBook.worksheets[ListBox1.ItemIndex+1].UsedRange.Rows.Count;
       col:=WorkBook.worksheets[ListBox1.ItemIndex+1].UsedRange.columns.Count;
       ComboBox2.Items.Clear ;
       CheckListBox1.Clear ;
       for i := 1 to col do
       begin
          if CheckBox1.Checked then
          begin
             ComboBox2.Items.Add(trim(WorkBook.WorkSheets[ListBox1.ItemIndex+1].Cells[1,i].value));
             CheckListBox1.Items.Add(trim(WorkBook.WorkSheets[ListBox1.ItemIndex+1].Cells[1,i].value)+' VarChar(50) NULL');
          end
          else
          begin
             ComboBox2.Items.Add('fields'+IntToStr(i));
             CheckListBox1.Items.Add('fields'+IntToStr(i)+' VarChar(50) NULL');
          end;
          CheckListBox1.Checked[i-1] := true;
       end;
       ComboBox2.ItemIndex := 0;
       ComboBox3.Items.Clear ;
       s := 'SELECT name FROM '+trim(Edit3.Text)+'..systypes';
       QuerySQL(ADO,s);
       while not ADO.Eof do
       begin
          ComboBox3.Items.Add(ADO.Fields[0].AsString);
          ADO.Next;
       end;
       PageControl1.ActivePage := Tabsheet6;
       ExpExcel := null;
       ExpExcel := Unassigned;
    end
    else if RadioButton2.Checked then
    begin
       if trim(ComboBox1.Text)='' then
       begin
          MessageDlg('必须先选择现有表的名称!', mtWarning, [mbOK], 0);
          abort;
       end else
       begin
           Edit6.Text :=ComboBox1.Text ;
           Button3.Caption :='完成';
           PageControl1.ActivePage := Tabsheet7;
       end;
    end;
end;

procedure TForm1.Wizard6 ;
begin
   PageControl1.ActivePage := Tabsheet7;
   Button3.Caption :='完成';
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
   try
      OpenDialog1.Execute ;
   except
   end;
   Edit1.Text := OpenDialog1.FileName;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
   ADOConn.Connected := false;
   ADOConn.ConnectionString := 'Provider=SQLOLEDB.1;Password='+Edit5.Text+
      ';Persist Security Info=True;User ID='+Edit4.Text+
      ';Initial Catalog='+Edit3.Text+';Data Source='+Edit2.Text;
   try
      ADOConn.Connected := true;
   except
      ADOConn.Connected := false;
      Application.MessageBox('连接失败','提示',64);
      abort;
   end;
   Button3.Enabled :=true;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
   if Button3.Caption ='完成' then
   begin
      Success;
   end
   else
   begin
      Button2.Enabled :=true;
      if PageControl1.ActivePage = Tabsheet1 then
      begin
         PageControl1.ActivePage := Tabsheet2;
         if Trim(Edit1.Text)='' then
            Button3.Enabled := false
         else
            Button3.Enabled := true;
      end
      else if PageControl1.ActivePage = Tabsheet2 then
      begin
         Wizard2;
      end
      else if PageControl1.ActivePage = Tabsheet3 then
      begin
         Wizard3;
      end
      else if PageControl1.ActivePage = Tabsheet4 then
      begin
        PageControl1.ActivePage := Tabsheet5;
        Wizard4;
     end
     else if PageControl1.ActivePage = Tabsheet5 then
     begin
       Wizard5;
     end
     else if PageControl1.ActivePage = Tabsheet6 then
     begin
        Wizard6;
     end;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   Label10.Caption :='Excel数据导入数据库"允许导入并转换异类数据， 该向导将指导您'+#13+'完成名个步骤。';
   Label12.Caption :='说明：'+#13#10+' 列标题不能为数值。 ';
   Label13.Caption :='电子表格文件含有一个以上工作或区域。'+#13+'请选择合适的工作或区域：';
   Label14.Caption :='导入表可以用列标题作为表的字段名称。请确定指定的第一行是否'+#13+'包含列标题：';
   Label15.Caption :='可以指定有关正在导入的每一字段的信息。在下面列表中选择字段，然后在〔字段选项〕框内对字段信息进行必要的更改。';
   Label16.Caption :='以上是向导导入数据所需的全部信息。'
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   Button3.Caption :='下一步 >';
   if PageControl1.ActivePage = Tabsheet7 then
   begin
      if RadioButton1.Checked then
         PageControl1.ActivePage := Tabsheet5
      else PageControl1.ActivePage := Tabsheet6;
   end
   else if PageControl1.ActivePage = Tabsheet6 then
   begin
      PageControl1.ActivePage := Tabsheet5;
   end
   else if PageControl1.ActivePage = Tabsheet5 then
   begin
      PageControl1.ActivePage := Tabsheet4;
   end
   else if PageControl1.ActivePage = Tabsheet4 then
   begin
      PageControl1.ActivePage := Tabsheet3;
   end else
   if PageControl1.ActivePage = Tabsheet3 then
   begin
      PageControl1.ActivePage := Tabsheet2;
   end else
   if PageControl1.ActivePage = Tabsheet2 then
   begin
      PageControl1.ActivePage := Tabsheet1;
      Button2.Enabled :=false;
   end;
end;

procedure TForm1.Success;
var
   row,i,j,col,check,FieldCount : integer;
   s ,temp: String;
   isSuccess: boolean;
begin
   isSuccess := true;
   if Length(trim(Edit6.Text))=0 then
      MessageDlg('请输入表名 !', mtWarning, [mbOK], 0)
   else
   begin
      try
         ExpExcel := CreateOleObject('Excel.Application');
      except
         MessageDlg('Can not creat Excel 2000 file !', mtWarning, [mbOK], 0);
         exit;
      end;
      WorkBook:= ExpExcel.Workbooks.Open(Edit1.Text);
      row:=WorkBook.worksheets[ListBox1.ItemIndex+1].UsedRange.Rows.Count;
      col:=WorkBook.worksheets[ListBox1.ItemIndex+1].UsedRange.columns.Count;
      if RadioButton1.Checked then    //导入新建的表中
      begin
         s := 'CREATE TABLE '+trim(Edit6.Text)+'(';
         for i:=0 to ComboBox2.Items.Count-1 do
         begin
            s := s +CheckListBox1.Items.Strings[i]+',';
         end;
         s := copy(s,0,length(s)-1);
         s := s +')';
         try
            ExecSQL(ADO,s);
         except
            abort;
         end;
         if CheckBox1.Checked then
            check :=2
         else
            check :=1;
         for i:=check to row do
         begin
            s :='';
            temp :='';
            for j:= 1 to col do
            begin
               s := s + ''''+trim(WorkBook.WorkSheets[ListBox1.ItemIndex+1].Cells[i,j].value)+''''+',';
               temp := temp + ComboBox2.Items.Strings[j-1]+ ',';
            end;
            s := copy(s,0,length(s)-1);
            temp := copy(temp,0,length(temp)-1);
            s := s + ')';
            s := 'INSERT INTO ' +Trim(Edit6.Text)+ ' ( '+temp +' ) values( '+ s;
            ExecSQL(ADO,s) ;
         end;
      end else if RadioButton2.Checked then  //导入现有表中
      begin
         s := 'select * from '+ Trim(Edit6.Text);
         QuerySQL(ADO,s);
         if ADO.FieldCount< col then
         begin
            if MessageDlg('导入数据格式可能不正确，如果导入则数据将会丢失.  要继续吗?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then
               isSuccess :=true
            else
            begin
               isSuccess :=false;
               exit;
            end;
         end;
         temp :='';
         FieldCount := ADO.FieldCount;
         for i:=1 to ADO.FieldCount do
         begin
            temp := temp +ADO.Fields[i-1].FieldName+',';
         end;
         temp := copy(temp,0,length(temp)-1);
         if CheckBox3.Checked then
         begin
            ExecSQL(ADO,'DELETE from '+Trim(Edit6.Text));
         end;
         for i :=1 to row do
         begin
            s :='';
            for j := 1 to FieldCount do
            begin
               s := s + ''''+trim(WorkBook.WorkSheets[ListBox1.ItemIndex+1].Cells[i,j].value)+''''+',';
            end;
            //showmessage(s);
            s := copy(s,0,length(s)-1);
            s := 'Insert Into '+Trim(Edit6.Text)+' ( '+temp+' ) values('+ s+')';
            //showmessage(inttostr(i)+'='+s);
            ExecSQL(ADO,s);
            //showmessage(inttostr(i)+'='+s);
         end;
      end;
      if isSuccess = true  then
         MessageDlg('完成向导导入数据完成!', mtInformation, [mbOK], 0)
      else
         MessageDlg('导入数据失败!', mtInformation, [mbOK], 0);
      ExpExcel := null;
      ExpExcel := Unassigned;
      close;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   HWndCalc:HWnd;
begin
  HWndCalc := Winprocs.FindWindow(nil, 'EXCEL.EXE'); // close the exist Calculator
  if HWndCalc <> 0 then
     PostMessage(HWndCalc, WM_CLOSE, 0, 0);
  close;
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
  ComboBox1.Enabled := false;
  CheckBox3.Enabled := false;
end;

procedure TForm1.RadioButton2Click(Sender: TObject);
var s:string;
begin
   ComboBox1.Enabled := true;
   CheckBox3.Enabled := true;
   s :='SELECT name FROM '+trim(Edit3.Text)+'..sysobjects where xtype=''U''' ;
   QuerySQL(ADO,s);
   ComboBox1.Items.Clear ;
   while not ADO.Eof do
   begin
      ComboBox1.Items.Add(ADO.Fields[0].AsString);
      ADO.Next;
   end;
end;

procedure TForm1.ComboBox3Change(Sender: TObject);
begin
   if ComboBox2.Text <>'' then
   begin
      if ComboBox3.Text <>'' then
      begin
         CheckListBox1.Items.Strings[ComboBox2.ItemIndex] :=ComboBox2.Text+' '+ComboBox3.Text+'(50) NULL' ;
      end;
   end;
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
var list : array of string;
    i,j:integer;
begin
   //setlength(list,CheckListBox1.Items.Count);
   //for
   //CheckListBox1.Selected[ComboBox2.ItemIndex] := true;
   //showmessage(inttostr(ComboBox2.ItemIndex)+','+inttostr(CheckListBox1.ItemIndex));
   //CheckListBox1.Items.Strings[ComboBox2.ItemIndex] :=ComboBox2.Text+' '+ComboBox3.Text+'(50) NULL' ;
end;

end.