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. Содрано, но проверенно работает + переделать под свои нужды не сложно, что я и сделал
