ITDim
    Все будет итышно, когда вы с нами :)

Delphi импорт из xls в таблицу БД



unit _t_mn_unt_;

interface

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

type
  TForm1 = class(TForm)
    _con_: TADOConnection;
    _clt_: TADODataSet;
    _buy_: TADODataSet;
    _ds_clt_: TDataSource;
    _ds_buy_: TDataSource;
    DBGrid1: TDBGrid;
    DBGrid2: TDBGrid;
    _opg_: TOpenDialog;
    Panel1: TPanel;
    Button1: TButton;
    _start_: TEdit;
    Label1: TLabel;
    _wrk_: TADOQuery;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


const
  xlCellTypeLastCell = $0000000B;
  appname = 'Read excel file';
  appbase = '_db_.mdb';
  Provider   = 'Provider=Microsoft.Jet.OLEDB.4.0;';
  PersistSI  = 'Persist Security Info=False';

type TClientRow = record
  _fio, _address, _birthplace : string;
  _birthdate : TDateTime;
end;

type TBuyRow = record
  _cl_id : integer;
  _product : string;
  _buydate : TDateTime;
end;

var
  Form1: TForm1;
  XLApp, Sheet, Range: OLEVariant;
  _tmp : TClientRow;
  _buy : TBuyRow;

implementation

{$R *.dfm}

function _get_sql(_type : integer) : string;
begin
  case _type of
// При работа с ADO у меня выдавало ошибку синтаксиса, пришлось 
// fio,address,birthdate,birthplace переделать в `fio`,`address`,`birthdate`,`birthplace` 
    0: Result :=  'INSERT INTO client(fio,address,birthdate,birthplace) VALUES' +
                  '(:fio,:address,:birthdate,:birthplace)';
    1: Result :=  'INSERT INTO buys(id_cl,predmet,buydate) VALUES' +
                  '(:id_cl,:predmet,:buydate)';
  end;
end;

function _ins_client_data( _val_ : TClientRow) : integer;
begin
  with _val_, Form1._wrk_ do
  begin
    SQL.Text := _get_sql(0);
    Parameters.ParamByName('fio').Value := _fio;
    Parameters.ParamByName('address').Value := _address;
    Parameters.ParamByName('birthdate').Value := _birthdate;
    Parameters.ParamByName('birthplace').Value := _birthplace;
    ExecSQL;
    SQL.Text := 'SELECT MAX(ID) AS MID FROM client';
    Open;
    Result := FieldByName('MID').AsInteger;
    Close;
  end;
end;

procedure _refresh_ds(_ds : TDataSet);
begin
  _ds.Close;
  _ds.Open;
end;

procedure _ins_buy_data(_val_ : TBuyRow);
begin
  with _val_, Form1._wrk_ do
  begin
    SQL.Text := _get_sql(1);
    Parameters.ParamByName('id_cl').Value := _cl_id;
    Parameters.ParamByName('predmet').Value := _product;
    Parameters.ParamByName('buydate').Value := _buydate;
    ExecSQL;
  end;
end;

function _get_value(x, y : integer) : string;
begin
  Result := VarToStr(XLApp.Cells.Item[x,y].Value);
end;

procedure _read_file(filename : string; start : integer);
var i, j, _cl : integer;
begin
  try
    XLApp := CreateOleObject('Excel.Application');
    XLApp.Visible := False;
    XLApp.Workbooks.Open(filename);
    Sheet := XLApp.Workbooks[ExtractFileName(filename)].WorkSheets[1];
    Range := Sheet.UsedRange;
    for i := start to Range.Rows.Count do
    begin
      try _tmp._birthdate :=  StrToDate(_get_value(i, 3)) except end;
      _tmp._fio := _get_value(i, 1);
      _tmp._address := _get_value(i, 2);
      _tmp._birthplace := _get_value(i, 4);
      _cl := _ins_client_data(_tmp);
      j := 5;
      while j < Range.Columns.Count do
      begin
        _buy._cl_id := _cl;
        _buy._product := _get_value(i, j);
        try _buy._buydate :=  StrToDate(_get_value(i, j + 1)) except end;
        _ins_buy_data(_buy);
        j := j + 2;
      end;
    end;
  finally
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  _opg_.Execute();
  _read_file(_opg_.FileName, StrToInt(_start_.Text));
  _refresh_ds(_clt_);
  _refresh_ds(_buy_);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := appname;
  _con_.Connected := false;
  _con_.ConnectionString := Provider + 'Data Source=' + appbase + ';' + PersistSI;
  _con_.Connected := true;
  _clt_.Open;
  _buy_.Open;
end;

end.

P.S. Содрано, но проверенно работает + переделать под свои нужды не сложно, что я и сделал

1 коммент.:

Sarff комментирует...

Кому нужны исходники пишите на почту vizits@ukr.net скину

Отправить комментарий