Delphi XE2 从Excel导入到数据库《LceMeaning》

╰半夏微凉° 2021-12-17 02:23 374阅读 0赞

以下代码经本人在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;

转载于:https://www.cnblogs.com/LceMeaning/p/3757343.html