导入excel-白红宇

unit ExcelProUnit;

interface

type

TExcelFunction = procedure(asheet: OleVariant); //声明导入函数

{访问单元格：sheet.cells[row,col]

转为string：vartostr(sheet.cells[row,col])

转为datetime：vartodatetime(sheet.cells[row,col])

}

//afilename为数据源文件名，func为执行导入的函数

procedure RunExcelApplication(afilename: string; func: TExcelFunction);

implementation

uses Controls, Forms, ComObj, windows, sysutils;

procedure RunExcelApplication(afilename: string;

func: TExcelFunction);

var

app: OleVariant;

oldCursor: TCurSor;

begin

oldCursor := Screen.Cursor;

//保存鼠标指针状态

Screen.Cursor := crHourGlass;

try

CoInitializeEx(nil, 0);

app := CreateOleObject('Excel.Application');

try

app.DisplayAlerts := False;

app.WorkBooks.open(afilename);

//打开源文件

app.WorkSheets[1].Activate;

app.visible := False; //隐藏excel窗体

if Assigned(func) then //执行导入函数

func(app.ActiveSheet); //传递sheet给函数进行导入

finally

app.WorkBooks.close;

app.quit; //关闭推出excel

Screen.Cursor := oldCursor;

end;

except on e: Exception do

begin

MessageBox(GetActiveWindow, pchar(e.message), '提示', MB_OK + MB_ICONINFORMATION);

Screen.Cursor := OldCursor;

Exit;

end;

end.

--------------------------------------------------------------------------

unit Unit2;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, DBGridEhGrouping, DB, ADODB, GridsEh, DBGridEh, StdCtrls, RzButton;

type

TForm2 = class(TForm)

Button1: TButton;

DBGridEh1: TDBGridEh;

ADOQuery1: TADOQuery;

DataSource1: TDataSource;

RzButton1: TRzButton;

Memo1: TMemo;

OpenDialog1: TOpenDialog;

adodata: TADOQuery;

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure RzButton1Click(Sender: TObject);

procedure exesql(str_sql:string);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

{$R *.dfm}

uses ExcelProUnit;

var

sl: tStrings;

pubsql:string;

procedure TForm2.Button1Click(Sender: TObject);

var

str_sql:string;

begin

str_sql := 'SELECT * FROM nameyp3';

with ADOQuery1 do

begin

close;

sql.Clear;

SQL.Add(str_sql);

open;

end;

DataSource1.DataSet := ADOQuery1;

DBGridEh1.DataSource := DataSource1;

end;

procedure GetFromExcel(asheet: OleVariant);

var

s, rs: string;

row: integer;

compute_00,ylxmmc,jsxmbh,lb,code,content,py,sxzfbl,jxbm,jxmc,spec,gssxzfbl,sysxzfbl:string;

adodata:TADOQuery;

begin

row := 1;

s := trim(vartostr(aSheet.cells[row, 1]));

pubsql := '';

while s <> '' do

begin

compute_00 := trim(vartostr(aSheet.cells[row, 1]));

ylxmmc := trim(vartostr(aSheet.cells[row, 2]));

jsxmbh := trim(vartostr(aSheet.cells[row, 3]));

lb := trim(vartostr(aSheet.cells[row, 4]));

code := trim(vartostr(aSheet.cells[row, 5]));

content := trim(vartostr(aSheet.cells[row, 6]));

py := trim(vartostr(aSheet.cells[row, 7]));

sxzfbl := trim(vartostr(aSheet.cells[row, 8]));

if sxzfbl = '' then

sxzfbl := '0';

jxbm := trim(vartostr(aSheet.cells[row, 9]));

jxmc := trim(vartostr(aSheet.cells[row, 10]));

spec := trim(vartostr(aSheet.cells[row, 11]));

gssxzfbl := trim(vartostr(aSheet.cells[row, 12]));

if (gssxzfbl = '') or (gssxzfbl = 'NULL') then

gssxzfbl := '0';

sysxzfbl := trim(vartostr(aSheet.cells[row, 13]));

if (sysxzfbl = '') or (sysxzfbl = 'NULL') then

sysxzfbl := '0';

pubsql := pubsql + ' insert into nameyp3(compute_00,ylxmmc,jsxmbh,lb,code,content,py,sxzfbl,jxbm,jxmc,spec,gssxzfbl,sysxzfbl)';

pubsql := pubsql + 'select ' + QuotedStr(compute_00) + ',' + QuotedStr(ylxmmc) + ',' + QuotedStr(jsxmbh)

+ ',' + QuotedStr(lb) + ',' + QuotedStr(code) + ',' + QuotedStr(content) + ',' + QuotedStr(py) + ',' + QuotedStr(sxzfbl)

+ ',' + QuotedStr(jxbm) + ',' + QuotedStr(jxmc) + ',' + QuotedStr(spec) + ',' + QuotedStr(gssxzfbl) + ',' + QuotedStr(sysxzfbl);

inc(row);

sl.Add(rs);

s := trim(vartostr(aSheet.cells[row, 1]));

end;

procedure TForm2.exesql(str_sql: string);

begin

with adodata do

begin

Close;

SQL.Clear;

SQL.Add(str_sql);

ExecSQL;

end;

procedure TForm2.FormCreate(Sender: TObject);

begin

sl := TStringList.Create;

end;

procedure TForm2.RzButton1Click(Sender: TObject);

begin

OpenDialog1.Title := '请选择正确的excel文件';

OpenDialog1.Filter := 'Excel(*.xls)|*.xls';

if OpenDialog1.Execute then

begin

// RunExcelApplication(ExtractFilePath(application.ExeName) + 'success.xls', GetFromExcel);

RunExcelApplication(OpenDialog1.FileName, GetFromExcel);

exesql(pubsql);

//memo1.Lines.AddStrings(sl);

end;

{

RunExcelApplication(ExtractFilePath(application.ExeName) + 'success.xlsx', GetFromExcel);

memo1.Lines.AddStrings(sl);

}

end;

end.

本文转自鹅倌51CTO博客，原文链接： http://blog.51cto.com/kaixinbuliao/1750764，如需转载请自行联系原作者