开发中经常有需要将Excel导入数据集的需要,但每张Excel的栏位都会不同,常规的做法有两种:
一、针对每一张Excel的栏位与数据集栏位位置在程序中写好,一一对应导入
二、针对每一张Excel的栏位与数据集栏位配置好应用参数
这两种方法都比较麻烦,很不灵活,所以我写了一个比较通用的方法,只要符合以下条件就可以直接使用:
一、针对每一张Excel的栏位与数据集栏位位置在程序中写好,一一对应导入
二、针对每一张Excel的栏位与数据集栏位配置好应用参数
这两种方法都比较麻烦,很不灵活,所以我写了一个比较通用的方法,只要符合以下条件就可以直接使用:
1、Excel第一行是栏位标题,第二行开始是数据
2、应用程序数据集显示控件如(dbgrid,dxdbgrid等)名称与Excel首行标题名一致(顺序可以不同,数量也可以不同,如Excel的栏位:工号,姓名,年龄;显示控件栏位:姓名,工号,年龄,创建时间;这也是可以的)
以下为delphi 代码:procedure ExportExcelToCDS(mygrid: TdxDBGrid; filename: string);
var
i,j,row,col,ValidFNCount:integer;
MyExcel,Sheet:Variant;
str1,Prompt,ts:string;
fieldnames:array of string;
fieldList:array of string;
ColIndex:array of Integer;//Excel列序号
tmpcds:TDataSet;
tmpds:TDataSource;
CelValue:string;
//搜索Excel的标题是否有对应到数据表中的字段
procedure SetFieldList;
var
t,t2,js:Integer;
str1,str2:string;
begin
//搜索Excel中的有效字段
for t:=1 to col do
begin
str1:=StringReplace(Sheet.Cells[1,t].Text,' ','',[rfReplaceAll]);
for t2:=0 to mygrid.ColumnCount-1 do
begin
str2:=StringReplace(mygrid.Columns[t2].Caption,' ','',[rfReplaceAll]);
if str1=str2 then
begin
ValidFNCount:=ValidFNCount+1;
Break;
end;
end;
end;
SetLength(fieldList,ValidFNCount);
SetLength(ColIndex,ValidFNCount);
js:=0;
for t:=1 to col do
begin
str1:=StringReplace(Sheet.Cells[1,t].Text,' ','',[rfReplaceAll]);
for t2:=0 to mygrid.ColumnCount-1 do
begin
str2:=StringReplace(mygrid.Columns[t2].Caption,' ','',[rfReplaceAll]);
if str1=str2 then
begin
fieldList[js]:=mygrid.Columns[t2].FieldName;//字段
fieldnames[js]:=mygrid.Columns[t2].Caption;//字段显示名称
ColIndex[js]:=t;//Excel列序号1...
js:=js+1;
Break;
end;
end;
end;
end;
function CheckField:string;
var
t:Integer;
str1:string;
begin
for t:=1 to col do
begin
str1:=stringreplace(Sheet.Cells[1,t].Text,' ','',[rfReplaceAll]);
if str1=fieldnames[i] then
begin
Break;
end;
Result:=str1;
end;
end;
//Excel列名至少有一个与grid中的字段相对应,是否不执行数据追加操作
function CheckFieldArray:Boolean;
var
t,t2:integer;
begin
t2:=0;
for t:=0 to col-1 do
begin
if Trim(fieldList[t])<>'' then
begin
t2:=1;
Break;
end;
end;
if t2=0 then
Result:=true
else
Result:=False;
end;
begin
if UpperCase(ExtractFileExt(filename))<>uppercase('.xlsx') then
begin
ExportXLSToCDS(mygrid,filename);
Exit;
End;
//支持Excel2007格式
tmpcds:=mygrid.DataSource.DataSet;
tmpds:=mygrid.DataSource;
try
MyExcel:=CreateOleObject('Excel.Application');
except
ts:='请安装Excel';
MessageDlg(ts,mtWarning,[mbok],0);
Exit;
end;
tmpcds.DisableControls;
SetLength(fieldnames,mygrid.ColumnCount);
try
for i:=0 to mygrid.ColumnCount-1 do
begin
if mygrid.Columns[i].Visible then
fieldnames[i]:=stringreplace(mygrid.Columns[i].Caption,' ','',[rfReplaceAll]);
end;
str1:=CheckField;
if str1<>'' then
begin
MessageDlg('Excel中的'+str1+'不正确',mtError,[mbOK],0);
Exit;
end;
MyExcel.Workbooks.open(filename);
Sheet:=MyExcel.ActiveSheet;
row:=Sheet.UsedRange.Rows.Count;//行数
col:=Sheet.UsedRange.Columns.Count;//列数
if row<=1 then
begin
Prompt:='Excel中至少有一条数据'+#13+'第一行是标题,其它行为数据行'+#13+'条件不符,操作取消';
MessageDlg(Prompt,mtWarning,[mbOK],0);
Exit;
end;
if col<=1 then
begin
Prompt:='Excel中至少有一列数据'+#13+'条件不符,操作取消';
MessageDlg(Prompt,mtWarning,[mbOK],0);
Exit;
end;
SetFieldList;
if CheckFieldArray then
begin
Prompt:='Excel中第一行中的列名至少有一个与列表中栏位相同'+#13+'条件不符,操作取消';
MessageDlg(Prompt,mtWarning,[mbOK],0);
Exit;
end;
Screen.Cursor:=crHourGlass;
if not tmpcds.Active then
tmpcds.Open;
for i:=2 to row do
begin
Application.ProcessMessages;
CelValue:=Trim(Sheet.Cells[i,0].Text);
if (CelValue='') then Continue;
tmpcds.Append;
for j:=0 to ValidFNCount-1 do
begin
Application.ProcessMessages;
CelValue:=Trim(Sheet.Cells[i,ColIndex[j]].Text);
try
//导入的数据文本不可以有公式,否则会出错
if (CelValue<>'') then
begin
case tmpcds.FieldByName(fieldList[j]).DataType of
ftString:
tmpcds.FieldByName(fieldList[j]).AsString:=CelValue;
ftSmallint,ftInteger,ftWord,ftBoolean,ftFloat,ftCurrency,
ftBCD,ftBytes:
tmpcds.FieldByName(fieldList[j]).Value:=StrToFloat(CelValue);
ftDate,ftTime,ftDateTime:
tmpcds.FieldByName(fieldList[j]).AsDateTime:=Sheet.Cells[i,ColIndex[j]].Value;
end;
end;
except
on E:Exception do
begin
MessageDlg(E.Message+#13+'写入字段'+fieldList[j]+'时出错,写入内容:'
+vartostr(CelValue)+#13+'Excel出错行列:'+inttostr(i)+','+inttostr(j),mtError,[mbOK],0);
end;
end;
end;
tmpcds.Post;
end;
finally
tmpcds.EnableControls;
MyExcel.Workbooks.close;
MyExcel.quit;
Sheet:=Unassigned;
MyExcel:=Unassigned;
Screen.Cursor:=crDefault;
MessageDlg('数据导入完毕',mtInformation,[mbOK],0);
end;
end;
以上方法通过创建Excel对象导入其数据的,未使用第三方控件,其传入参数dxgrid可以改成您应用程序自已的控件类型,只要其带有datasource.dataset属性即可,比较灵活,但数据量比较大时可能比较慢,所以我做了一下改进,使用第三方控件读取Excel,再执行导入操作,这样速度非常快,以下是我改进的使用TcxSpreadSheet控件读取Excel的方法:
procedure ExportXLSToCDS(mygrid:TdxDBGrid;filename:string);//将excel导入数据集
var
i,j,row,col,ValidFNCount:integer;
MyExcel:TcxSpreadSheet;
str1,Prompt:string;
fieldnames:array of string;
fieldList:array of string;
ColIndex:array of Integer;//Excel列序号
tmpcds:TDataSet;
tmpds:TDataSource;
CelValue:string;
//搜索Excel的标题是否有对应到数据表中的字段
procedure SetFieldList;
var
t,t2,js:Integer;
str1,str2:string;
begin
//搜索Excel中的有效字段
for t:=0 to col-1 do
begin
str1:=StringReplace(MyExcel.Sheet.getcellobject(t,0).Text,' ','',[rfReplaceAll]);
for t2:=0 to mygrid.ColumnCount-1 do
begin
str2:=StringReplace(mygrid.Columns[t2].Caption,' ','',[rfReplaceAll]);
if str1=str2 then
begin
ValidFNCount:=ValidFNCount+1;
Break;
end;
end;
end;
SetLength(fieldList,ValidFNCount);
SetLength(ColIndex,ValidFNCount);
js:=0;
for t:=0 to col-1 do
begin
str1:=StringReplace(MyExcel.Sheet.getcellobject(t,0).Text,' ','',[rfReplaceAll]);
for t2:=0 to mygrid.ColumnCount-1 do
begin
str2:=StringReplace(mygrid.Columns[t2].Caption,' ','',[rfReplaceAll]);
if str1=str2 then
begin
fieldList[js]:=mygrid.Columns[t2].FieldName;//字段
fieldnames[js]:=mygrid.Columns[t2].Caption;//字段显示名称
ColIndex[js]:=t;//Excel列序号1...
js:=js+1;
Break;
end;
end;
end;
end;
function CheckField:string;
var
t:Integer;
str1:string;
begin
for t:=0 to col-1 do
begin
str1:=stringreplace(MyExcel.Sheet.getcellobject(t,0).Text,' ','',[rfReplaceAll]);
if str1=fieldnames[i] then
begin
Break;
end;
Result:=str1;
end;
end;
//Excel列名至少有一个与grid中的字段相对应,是否不执行数据追加操作
function CheckFieldArray:Boolean;
var
t,t2:integer;
begin
t2:=0;
for t:=0 to col-1 do
begin
if Trim(fieldList[t])<>'' then
begin
t2:=1;
Break;
end;
end;
if t2=0 then
Result:=true
else
Result:=False;
end;
begin
tmpcds:=mygrid.DataSource.DataSet;
tmpds:=mygrid.DataSource;
MyExcel:=TcxSpreadSheet.Create(nil);
tmpcds.DisableControls;
SetLength(fieldnames,mygrid.ColumnCount);
try
for i:=0 to mygrid.ColumnCount-1 do
begin
if mygrid.Columns[i].Visible then
fieldnames[i]:=stringreplace(mygrid.Columns[i].Caption,' ','',[rfReplaceAll]);
end;
str1:=CheckField;
if str1<>'' then
begin
MessageDlg('Excel中的'+str1+'不正确',mtError,[mbOK],0);
Exit;
end;
MyExcel.LoadFromFile(filename);
row:=MyExcel.Sheet.ContentRowCount;//行数
col:=MyExcel.Sheet.ContentColCount;//列数
if row<=1 then
begin
Prompt:='Excel中至少有一条数据'+#13+'第一行是标题,其它行为数据行'+#13+'条件不符,操作取消';
MessageDlg(Prompt,mtWarning,[mbOK],0);
Exit;
end;
if col<=1 then
begin
Prompt:='Excel中至少有一列数据'+#13+'条件不符,操作取消';
MessageDlg(Prompt,mtWarning,[mbOK],0);
Exit;
end;
SetFieldList;
if CheckFieldArray then
begin
Prompt:='Excel中第一行中的列名至少有一个与列表中栏位相同'+#13+'条件不符,操作取消';
MessageDlg(Prompt,mtWarning,[mbOK],0);
Exit;
end;
Screen.Cursor:=crHourGlass;
if not tmpcds.Active then
tmpcds.Open;
for i:=1 to row-1 do
begin
Application.ProcessMessages;
CelValue:=Trim(MyExcel.Sheet.getcellobject(ColIndex[0],i).DisplayText);
if (CelValue='') then Continue;
tmpcds.Append;
for j:=0 to ValidFNCount-1 do
begin
Application.ProcessMessages;
CelValue:=MyExcel.Sheet.getcellobject(ColIndex[j],i).DisplayText;
try
//导入的数据文本不可以有公式,否则会出错
if VarToStr(CelValue)<>'' then
begin
case tmpcds.FieldByName(fieldList[j]).DataType of
ftString:
tmpcds.FieldByName(fieldList[j]).AsString:=CelValue;
ftSmallint,ftInteger,ftWord,ftBoolean,ftFloat,ftCurrency,
ftBCD,ftBytes:
tmpcds.FieldByName(fieldList[j]).Value:=StrToFloat(CelValue);
ftDate,ftTime,ftDateTime:
tmpcds.FieldByName(fieldList[j]).AsDateTime:=MyExcel.Sheet.getcellobject(ColIndex[j],i).DateTime;
end;
end;
except
on E:Exception do
begin
MessageDlg(E.Message+#13+'写入字段'+fieldList[j]+'时出错,写入内容:'
+vartostr(CelValue)+#13+'Excel出错行列:'+inttostr(i)+','+inttostr(j),mtError,[mbOK],0);
end;
end;
end;
tmpcds.Post;
end;
finally
tmpcds.EnableControls;
Screen.Cursor:=crDefault;
FreeAndNil(MyExcel);
MessageDlg('数据导入完毕',mtInformation,[mbOK],0);
end;
end;
注:我使用的TcxSpreadSheet版本比较低,只支持.xls格式.各种开发工具使用以上方法只要将代码稍做改动即可。