将excel导入数据集
要求:需引用excel2000单元,excel文件第一行为标题
特点:excel文件的标题与dbgrid的标题名称一致,顺序可以不同
procedure ExportExcelToCDS(mygrid:TdxDBGrid;filename:string);//将excel导入数据集 var i,j,row,col,ValidFNCount:integer; ExcelApplication1:tExcelApplication; ExcelWorkbook1:tExcelWorkbook; ExcelWorksheet1:tExcelWorksheet; str1,Prompt:string; fieldnames:string; fieldList:array of string; ColIndex:array of Integer;//Excel列序号 tmpcds:TDataSet; tmpds:TDataSource; //搜索Excel的标题是否有对应到数据表中的字段 procedure SetFieldList; var t,t2,js:Integer; str1,str2:string; begin //搜索Excel中的有效字段 for t:=1 to col do begin str1:=StringReplace(VarToStr(ExcelWorksheet1.Cells.Item[1,t]),' ','',[rfReplaceAll]); for t2:=0 to mygrid.ColumnCount-1 do begin str2:=StringReplace(mygrid.Columns[t2].Caption,' ','',[rfReplaceAll]); if Pos(str1,str2)<>0 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(VarToStr(ExcelWorksheet1.Cells.Item[1,t]),' ','',[rfReplaceAll]); for t2:=0 to mygrid.ColumnCount-1 do begin str2:=StringReplace(mygrid.Columns[t2].Caption,' ','',[rfReplaceAll]); if Pos(str1,str2)<>0 then begin fieldList[js]:=mygrid.Columns[t2].FieldName;//字段 ColIndex[js]:=t;//Excel列序号1... js:=js+1; Break; end; end; 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; excelapplication1:=tExcelApplication.Create(nil);//初始化EXCEL excelworkbook1:=texcelworkbook.Create(nil); excelworksheet1:=texcelworksheet.Create(nil); excelapplication1.Visible[0]:=False; try try ExcelApplication1.Connect; except MessageDlg('Excel没有被安装',mtError,[mbOK],0); Exit; end; for i:=0 to mygrid.ColumnCount-1 do begin if mygrid.Columns[i].Visible then fieldnames:=fieldnames+stringreplace(mygrid.Columns[i].Caption,' ','',[rfReplaceAll])+','; end; ExcelApplication1.Caption :='Excel'; //打开EXCEL ExcelApplication1.Workbooks.Open(FileName,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,0); ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]); ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet); row:=ExcelWorksheet1.UsedRange[0].Rows.Count;//行数 col:=ExcelWorksheet1.UsedRange[0].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; mygrid.DataSource:=nil; Screen.Cursor:=crHourGlass; if not tmpcds.Active then tmpcds.Open; for i:=2 to row do begin Application.ProcessMessages; tmpcds.Append; for j:=1 to ValidFNCount do begin tmpcds.FieldByName(fieldList[j-1]).AsVariant:=Excelworksheet1.Cells.Item[i,ColIndex[j-1]]; end; tmpcds.Post; end; mygrid.DataSource:=tmpds; MessageDlg('数据导入完毕',mtInformation,[mbOK],0); finally ExcelApplication1.Disconnect ; ExcelApplication1.Quit; FreeAndNil(ExcelWorksheet1); FreeAndNil(excelworkbook1); FreeAndNil(excelapplication1); if mygrid.DataSource=nil then mygrid.DataSource:=tmpds; Screen.Cursor:=crDefault; end; end;