• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

DelphiXE2从Excel导入到数据库《LceMeaning》

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

以下代码经本人在Delphi XE2 下通过编译

uses
  Comobj;

procedure EXCEL1Click(Sender: TObject);
const
  BeginRow= 1;
  BeginCol= 2;
var
  iRE, I :Integer;
  iRow,iCol :Integer; //列、行
  MsExcel, MsExcelWorkBook, MsExcelWorkSheet : Variant;
begin
  try
    if not dlgOpen1.Execute then
      begin
        Exit;
      end;
    if ExtractFileExt(dlgOpen1.FileName) <> '.xls' then
      begin
        MessageBox(0, '请选择正确的Excel文件',PChar('警告!'),MB_OK or MB_ICONWARNING);
        Exit;
      end;
      try
        MsExcel := CreateOleObject('Excel.Application');
      except
        MessageBox(self.Handle,'本机未安装Excel, 请先安装Excel再执行本操作!      ','警告!',0);;
        Exit;
      end;
    MsExcel.visible := False;
    MsExcelWorkBook := MsExcel.WorkBooks.Open(dlgOpen1.FileName);
  except
    Exit;
  end;
  //开始从EXCEL文件读取相关信息 ,并导入到数据库中的表
  try
    iRow := BeginRow;
    iCol := BeginCol;
    I := 1000;
    while trim(msExcel.WorkSheets[1].Cells[iCol,iRow].value) <> '' do
      begin
        with qrySet do
        begin
          Close;
          SQL.Clear;
          SQl.Add('insert into ProductInfo(ProCode,ProName,PinyinCode,Barcode,ProType,Inventory,'+
          'MeasurementUnit,Cost,Price,MemberPrice,Notes) values(:ProCode,:ProName,:PinyinCode,:Barcode,'+
          ':ProType,:Inventory,:MeasurementUnit,:Cost,:Price,:MemberPrice,:Notes)');
          if Length(Trim(msExcel.WorkSheets[1].Cells[iCol,iRow].value)) > 12 then
            parameters.ParamByName('ProCode').Value := Trim(msExcel.WorkSheets[1].Cells[iCol,iRow].value)
          else
            parameters.ParamByName('ProCode').Value := 'P'+FormatDateTime('yymmddhhmmss',Now) + inttostr(I);
          if Trim(msExcel.WorkSheets[1].Cells[iCol,iRow].value) = '记录数:' then
            break;
          parameters.ParamByName('Barcode').Value := Trim(msExcel.WorkSheets[1].Cells[iCol,iRow+1].value);
          parameters.ParamByName('ProName').Value := Trim(msExcel.WorkSheets[1].Cells[iCol,iRow+2].value);
          parameters.ParamByName('ProType').Value := Trim(msExcel.WorkSheets[1].Cells[iCol,iRow+3].value);
          parameters.ParamByName('PinyinCode').Value := Trim(msExcel.WorkSheets[1].Cells[iCol,iRow+4].value);
          parameters.ParamByName('Cost').Value := StrToFloatDef(Trim(msExcel.WorkSheets[1].Cells[iCol,iRow+5].value),0);
          parameters.ParamByName('Price').Value := Trim(msExcel.WorkSheets[1].Cells[iCol,iRow+6].value);
          parameters.ParamByName('MemberPrice').Value := Trim(msExcel.WorkSheets[1].Cells[iCol,iRow+7].value);
          parameters.ParamByName('Inventory').Value := StrToIntDef(Trim(msExcel.WorkSheets[1].Cells[iCol,iRow+8].value),0);
          parameters.ParamByName('MeasurementUnit').Value := Trim(msExcel.WorkSheets[1].Cells[iCol,iRow+9].value);
          parameters.ParamByName('Notes').Value := Trim(msExcel.WorkSheets[1].Cells[iCol,iRow+10].value);
          ExecSQL;
        end;
        iCol:=iCol + 1;
        I := I + 1;
        Application.ProcessMessages;//防止进程阻塞
      end;
    MsExcel.Quit;
  except
    MessageBox(self.Handle,'数据导入失败!','警告!',0);;
    MsExcel.Quit;
    Exit;
  end;//end try
  MessageBox(self.Handle,'数据导入成功!','提示!',0);
  qrypro.Close;
  qryPro.Open;
end;

 


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
Matlab文件命名规则发布时间:2022-07-18
下一篇:
MATLAB中 feval 函数的用法发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap