Здарова, Олег Кузьмин!
15 апреля 2004 г., четверг, 16:15:00 (GMT+05:00), пришел ко мне
почтальон Почкин и всучил письмо с пометкой "импорт Exelевской таблицы.",
в котором сообщалось следующее:
>> Для этого можно воспользоваться технологией OLE. В справке к Делфи
>> неплохо описана. При желании информацию можно поискать в интернете.
>>
ОК> Я конечно посмотрю, но на самом деле мне хотелось немного другое. Я хотел
бы
ОК> скопировать экселевскую таблицу в свою БД, и там с ней работать средствами
ОК> Дельфи. А при использование OLE ведь прийдётся обходиться средствами exel?
ОК> Мне этих средств не хватит. Если бы я мог обойтись средствами exel я не
ОК> писал бы свою программу...
Я как-то ради интереса написал такую штуку xls->db (писал под
конкретную xls-ку). Тормозит само формирование таблицы (ну для 5 тыс. строк,
я так думаю, не будет так заметно, я тестировал на 65000 - было
несколько минут) да вообще это был мой самый первый опыт работы с
базами, пусть знающие люди подправят если что криво сделано и можно
пооптимизированне, получение содержания файла xls происходит
мгновенно.
==Начало Unit1.pas==
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComObj, ComCtrls, Excel97, Db, DBTables, Grids, DBGrids;
type
TForm1 = class(TForm)
Button6: TButton;
DBGrid1: TDBGrid;
Table1: TTable;
Query1: TQuery;
DataSource1: TDataSource;
Button1: TButton;
Button2: TButton;
StatusBar1: TStatusBar;
procedure Button6Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ProgressBar1: TProgressBar;
var v:variant;
implementation
{$R *.DFM}
type
TCellPos = record
Row,
Col: integer;
end;
function GetLastCell(sh: variant): TCellPos;
const
xlLastCell = 11;
var
range: Variant;
begin
range:=sh.Cells.SpecialCells(xlLastCell);
Result.Row:=range.Row;
Result.Col:=range.Column;
range:=Unassigned;
end;
procedure TForm1.Button6Click(Sender: TObject);
const sql_='INSERT INTO employee.db ' +
'(Number, Item_Name, Cost_YE, Cost_RU, Warranty, Shop, ' +
'Number2, Item_Name2, Cost_YE2, Cost_RU2, Warranty2, Shop2, ' +
'Number3, Item_Name3, Cost_YE3, Cost_RU3, Warranty3, Shop3, ' +
'Number4, Item_Name4, Cost_YE4, Cost_RU4, Warranty4, Shop4) ' +
'VALUES ( ';
var excel,workbook,sheet,IRange:variant;
Values:OLEVariant;
{maxSheet,iSheet,}maxColumns,iColumns,maxRow,iRow:integer;
GTK,GTK2,GTK3:DWORD;
tmp,sql:string;
begin
excel:=CreateOleObject('Excel.Application');
try
GTK2:=GetTickCount;
//workbook:=excel.Workbooks.Open('D:\!!!!!!!!!NADO\_tomilov\комп_2.xls');
workbook:=excel.Workbooks.Open('D:\!!!!!!!!!NADO\_tomilov\Копия Прайс Электрон.xls');
//workbook:=excel.Workbooks.Open('D:\!!!!!!!!!NADO\_tomilov\Прайс Электрон.xls');
GTK2:=GetTickCount-GTK2;
try
GTK3:=GetTickCount;
sheet:=workbook.Worksheets.Item[2];
IRange:=sheet.UsedRange;
maxRow:=IRange.Rows.Count;
maxColumns:=IRange.Columns.Count;
Values:=IRange.Value;
GTK3:=GetTickCount-GTK3;
ProgressBar1.Max:=maxRow;
Table1.Active:=false;
Query1.sql.Clear;
GTK:=GetTickCount;
for iRow:=1 to maxRow do
begin
sql:=sql_+IntTostr(iRow)+' , ';
for iColumns:=2 to maxColumns do
begin
try
tmp:=Values[iRow,iColumns];
except
tmp:='';
end;
if (iColumns=2) or (iColumns=5) or (iColumns=6) or
(iColumns=8) or (iColumns=11) or (iColumns=12) or
(iColumns=14) or (iColumns=17) or (iColumns=18) or
(iColumns=20) or (iColumns=23) or (iColumns=24)
then tmp:='"'+tmp+'"'
else if tmp='' then tmp:='0';
if iColumns=24
then sql:=sql+tmp+' ) '
else sql:=sql+tmp+' , ';
end;
try
Query1.UnPrepare;
Query1.sql.Text:=sql;
Query1.Prepare;
Query1.ExecSQL;
except
end;
if iRow mod 250=0 then
begin
ProgressBar1.Position:=iRow;
Application.ProcessMessages;
end;
end;
table1.TableName:=ExtractFilePath(ParamStr(0))+'employee.db';
Table1.Active:=true;
GTK:=GetTickCount-GTK;
ShowMessage(IntTostr(GTK2)+' '+IntTostr(GTK3)+' '+IntTostr(GTK));
finally
IRange:=Unassigned;
Values:=Unassigned;
sheet:=Unassigned;
workbook:=Unassigned;
end;
finally
excel.Quit;
excel:=null;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var sql:string;
begin
Table1.Active:=false;
if not FileExists('employee.db') then
begin
Query1.UnPrepare;
sql:='CREATE TABLE "employee.db" '+
'( Number SMALLINT, Item_Name CHAR(50), Cost_YE NUMERIC(20,20), Cost_RU
NUMERIC(20,20), '+
'Warranty CHAR(15), Shop CHAR(50), '+
'Number2 SMALLINT, Item_Name2 CHAR(50), Cost_YE2 NUMERIC(20,20),
Cost_RU2 NUMERIC(20,20), '+
'Warranty2 CHAR(15), Shop2 CHAR(50), '+
'Number3 SMALLINT, Item_Name3 CHAR(50), Cost_YE3 NUMERIC(20,20),
Cost_RU3 NUMERIC(20,20), '+
'Warranty3 CHAR(15), Shop3 CHAR(50), '+
'Number4 SMALLINT, Item_Name4 CHAR(50), Cost_YE4 NUMERIC(20,20),
Cost_RU4 NUMERIC(20,20), '+
'Warranty4 CHAR(15), Shop4 CHAR(50), '+
'PRIMARY KEY (Number))';
Query1.sql.text:=sql;
Query1.Prepare;
Query1.ExecSQL;
end;
table1.TableName:=ExtractFilePath(ParamStr(0))+'employee.db';
Table1.Active:=true;
end;
procedure TForm1.Button2Click(Sender: TObject);
var sql:string;
begin
Table1.Active:=false;
Query1.UnPrepare;
Query1.sql.Clear;
sql:='INSERT INTO employee.db ' +
'(Number, Item_Name, Cost_YE, Cost_RU, Warranty, Shop) ' +
'VALUES (1, "CD", 5, 150, "No", "" )';
Query1.sql.Text:=sql;
Query1.Prepare;
Query1.ExecSQL;
Query1.UnPrepare;
sql:='INSERT INTO employee.db ' +
'(Number, Item_Name, Cost_YE, Cost_RU, Warranty, Shop) ' +
'VALUES (2, "CD", 5, 150, "No", "" )';
Query1.sql.Text:=sql;
Query1.Prepare;
Query1.ExecSQL;
table1.TableName:=ExtractFilePath(ParamStr(0))+'employee.db';
Table1.Active:=true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
{while not (csDesigning in ComponentState) do
begin
Application.ProcessMessages;
sleep(10);
end; }
ProgressBar1:=TProgressBar.Create(StatusBar1);
ProgressBar1.Parent:=StatusBar1;
ProgressBar1.Align:=alClient;
ProgressBar1.Left:=0;
ProgressBar1.Width:=1024;
ProgressBar1.Smooth:=true;
ProgressBar1.Height:=18;
end;
end.
==Конец Unit1.pas==
==Начало Unit1.dfm==
object Form1: TForm1
Left = 202
Top = 113
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object DBGrid1: TDBGrid
Left = 0
Top = 0
Width = 688
Height = 433
Align = alClient
DataSource = DataSource1
TabOrder = 1
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object Button6: TButton
Left = 650
Top = 84
Width = 33
Height = 25
Caption = 'Button6'
TabOrder = 0
OnClick = Button6Click
end
object Button1: TButton
Left = 570
Top = 82
Width = 45
Height = 25
Caption = 'Create'
TabOrder = 2
OnClick = Button1Click
end
object Button2: TButton
Left = 616
Top = 84
Width = 33
Height = 25
Caption = 'Add'
TabOrder = 3
OnClick = Button2Click
end
object StatusBar1: TStatusBar
Left = 0
Top = 433
Width = 688
Height = 19
Panels = <
item
Width = 1024
end>
SimplePanel = False
end
object Table1: TTable
DatabaseName = 'DefaultDD'
Left = 116
Top = 106
end
object Query1: TQuery
Left = 152
Top = 106
end
object DataSource1: TDataSource
DataSet = Table1
Left = 188
Top = 110
end
end
==Конец Unit1.dfm==
