Topic: Example LoopReadExcel2
Original Basic Project Example Auto Import Value Multiple Excel (Easy Code!)
http://myvisualdatabase.com/forum/viewtopic.php?id=5163
For MVD Community Happy ! Happy ! New Add Component Display
- Status Import Process
- Count Down Row Import
- Progress Bar
Screen
Open Code
var
apppath : string;
pb : Tprogressbar;
procedure Form1_TableGrid2_OnChange (Sender: TObject);
begin
Form1.TableGrid2.BestFitColumns(bfboth);
end;
procedure Form1_Button2_OnClick (Sender: TObject; var Cancel: boolean);
var
t : integer;
i : integer;
r : integer;
c : integer;
ExcelFile : Variant;
WorkBook : Variant;
WorkSheet : Variant;
MaxRow : Integer;
MaxCol : Integer;
value : String;
sql_code : string;
records : integer;
records_all : integer;
begin
records_all := 0;
For t := 0 To Form1.TableGrid1.RowCount - 1 do
begin
Form1.Label11.Caption := Form1.TableGrid1.Cells[0,t];
Form1.Label2.Caption := Inttostr(t+1)+'/'+ inttostr(Form1.TableGrid1.RowCount);
ExcelFile := CreateOleObject('Excel.Application');
WorkBook := ExcelFile.WorkBooks.Open( Form1.TableGrid1.Cells[0,t] );
WorkSheet := WorkBook.WorkSheets.Item['sheet1'];
MaxRow := WorkSheet.Usedrange.EntireRow.count;
MaxCol := WorkSheet.Usedrange.EntireColumn.count;
Form1.Label5.Caption := Formatfloat(',0',Maxrow-1);
Form1.Label7.Caption := Formatfloat(',0',Maxcol);
records := 0;
For r := 2 To MaxRow Do //No Head Column Start At Row 2 Excel
Begin
value := '';
For c := 1 To maxCol Do //Start At Column 1 Excel
Begin
value := value +'"'+WorkSheet.Cells[r, c].Value+'",';
End
;
records := records +1;
Form1.Label9.caption := Formatfloat(',0',records)+'/'+Formatfloat(',0',Maxrow-1);
sql_code := 'Insert OR Ignore Into value_excel (long_string) values (''{'+Copy(value,1,Length(value)-1)+'}'');';
sqlexecute(sql_code);
pb.position := round( (r-1)/(maxRow-1)*100.00 );
Form1.Label10.Caption := Formatfloat('.00',((r-1)/(maxRow-1)*100.00))+' %';
records_all := records_all +1;
application.ProcessMessages;
End;
WorkBook.Save;
WorkBook.Close;
ExcelFile.Quit;
sqlexecute(' update file_excel set record = '+IntToStr(records) +' where path = "'+escape_special_characters(Form1.Label11.Caption)+'";');
Form1.TableGrid1.dbUpdate;
application.ProcessMessages;
end;
showmessage('OK! '+FormatFloat(',0',records_all)+' Records' );
end;
procedure Form1_OnClose (Sender: TObject; Action: string);
begin
sqlexecute('delete from file_excel;');
end;
procedure Form1_TableGrid1_OnChange (Sender: TObject);
begin
Form1.TableGrid1.BestFitColumns(bfboth);
end;
procedure Form1_Button1_OnClick (Sender: TObject; var Cancel: boolean);
var
s : String;
sl: Tstringlist;
i : integer;
begin
Form1.Label2.Caption := '0/0';
Form1.Label5.Caption := '0';
Form1.Label7.Caption := '0';
Form1.Label9.Caption := '0/0';
Form1.Label10.Caption := '0 %';
sqlexecute('delete from file_excel;');
Form1.TableGrid1.dbUpdate;
SelectDirectory('Select Folder Excel Files','',s,True,True);
Form1.Edit1.Text := s;
sl := Tstringlist.create;
sl.text := GetFilesList(Form1.Edit1.Text ,'*.xls*',true);
For i := 0 To sl.count - 1 DO
sqlexecute('insert into file_excel (path,record) values ("'+
escape_special_characters(sl[i])+'",0);');
Form1.TableGrid1.dbUpdate;
sl.free;
end;
begin
apppath := ExtractFilePath(Application.ExeName);
pb := Tprogressbar.Create(Form1);
pb.parent := Form1.Panel2;
pb.align := alclient;
pb.min := 0;
pb.max := 100;
pb.barcolor := clRed;
pb.BackgroundColor := clblack;
pb.width := form1.Panel2.Width;
pb.position := 0;
end.
Easy For Beginner Student For Me