Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Using Delphi, from Excel to JSON, then FireDAC
unit uExcelToFireDAC;
interface
uses
System.SysUtils, System.Json, Winapi.ActiveX, Winapi.Windows,
System.Win.ComObj, Variants, System.Classes,
FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.MySQL,
FireDAC.Phys.MySQLDef, FireDAC.VCLUI.Wait, Data.DB, FireDAC.Comp.Client,
FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt,
FireDAC.Comp.DataSet;
type
IExcelToFireDAC = interface(IInterface)
procedure json_to_fdinsert(cells: TRect; sql_string: String; json_data: TJSONObject);
procedure OnMessage_(const pro: TGetStrProc);
end;
TExcelToFireDAC = class(TInterfacedObject, IExcelToFireDAC)
private
FFDConn1: TFDConnection;
FFDQuery_: TFDQuery;
FOnMessage: TGetStrProc;
FJsonData: TJSONObject;
procedure message_log(const msg_: String);
public
constructor Create(const connne: TFDConnection);
destructor Destroy; override;
class function ExcelToJson(cells: TRect; excel_filename, sheet_name: String):TJSONObject;
procedure json_to_fdinsert(cells: TRect; sql_string: String; json_data: TJSONObject);
property OnMessage: TGetStrProc read FOnMessage write FOnMessage;
procedure OnMessage_(const pro: TGetStrProc);
end;
implementation
{ TExcelToFireDAC }
constructor TExcelToFireDAC.Create(const connne: TFDConnection);
begin
inherited Create;
FJsonData := nil;
FOnMessage := nil;
FFDConn1 := connne;
FFDQuery_ := TFDQuery.Create(nil);
end;
destructor TExcelToFireDAC.Destroy;
begin
if Assigned(FJsonData) then
FJsonData.DisposeOf;
FFDQuery_.DisposeOf;
inherited;
end;
class function TExcelToFireDAC.ExcelToJson(cells: TRect; excel_filename, sheet_name: String): TJSONObject;
const
def_excel_application = 'Excel.Application';
var
jres: TJSONObject;
jline: TJSONObject;
ExcelApp, //Excel.Application
excel_book, //Excel Book
excel_sheet: Variant; //Excel Sheet
s: String;
iCol: Integer;
iRow: Integer;
begin
ExcelApp := CreateOleObject(def_excel_application);
jres := TJSONObject.Create;
try
jres.AddPair('sheet', TJSONArray.Create);
try
excel_book := ExcelApp.Workbooks.Open(excel_filename);
excel_sheet := excel_book.Worksheets.item[sheet_name];
for iRow := cells.Top to cells.Bottom do
begin
jline := TJSONObject.Create;
jres.GetValue<TJSONArray>('sheet').Add(jline);
for iCol := cells.Left to cells.Right do
begin
s := excel_sheet.Cells[iRow,iCol];
//if s.Length = 0 then
// s := 'null';
jline.AddPair(Format('column_%d', [iCol]),s);
end;
end;
finally
excel_sheet := Unassigned();
excel_book := Unassigned();
end;
finally
ExcelApp := Unassigned();
end;
Result := jres;
end;
procedure TExcelToFireDAC.json_to_fdinsert(cells: TRect; sql_string: String;
json_data: TJSONObject);
var
iRow,
iCol: Integer;
jlines: TJSONArray;
value_: TJSONValue;
value_str: String;
sql_line: String;
stSQL: String;
begin
FFDQuery_.Connection := FFDConn1;
FJsonData := json_data;
jlines := json_data.GetValue<TJSONArray>('sheet');
for iRow := 0 to jlines.Count-1 do
begin
sql_line := '';
for iCol := cells.Left-1 to cells.Right-1 do
begin
try
value_ := jlines.Items[iRow].GetValue<TJSONValue>(Format('column_%d', [iCol+1]));
if SameText(value_.Value, 'null') then
value_str := 'null,'
else
value_str := Format('''%s'',', [value_.Value]);
sql_line := sql_line + value_str;
except
end;
end;
try
Delete(sql_line, sql_line.Length, 1);
stSQL := Format(sql_string, [sql_line]);
message_log(stSQL);
FFDQuery_.SQL.Text := stSQL;
FFDQuery_.ExecSQL;
except
on e: Exception do
message_log(e.Message);
end;
end;
end;
procedure TExcelToFireDAC.message_log(const msg_: String);
begin
if Assigned(FOnMessage) then
FOnMessage(msg_);
end;
procedure TExcelToFireDAC.OnMessage_(const pro: TGetStrProc);
begin
FOnMessage := pro;
end;
end.
Owner

mojeld commented Feb 8, 2017

How to call

procedure TForm1.Button1Click(Sender: TObject);
var
  jbase:    TJSONObject;
  excetofd: IExcelToFireDAC;
  rect:     TRect;
begin
  rect  := TRect.Create(2,2,5,6);//Excel Position(Top, Left, Right, Bottom)
  jbase :=  TExcelToFireDAC.ExcelToJson(rect,'Book1.xlsx','Sheet1');
  Memo1.Lines.Append(  jbase.ToString );

  excetofd  := TExcelToFireDAC.Create(FDConnection1);
  excetofd.OnMessage_(msg_log);
  excetofd.json_to_fdinsert(rect,
    'INSERT INTO `t_MotoGP` (`position`,`racer_name`,`team_name`,`point_sum`) '
      + 'VALUES (%s)',jbase);
end;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment