Excel導出。PageControl - Delphi / VCL組件開發(fā)及應用

wangsongliang 2011-01-03

展開全文

procedure TRES_DCC_ECRN_F.cxButton1Click(Sender: TObject);
var
ExcelApp,WorkBook:Olevariant;
ExcelSheetCount,i,k:Integer;
begin
inherited;
if RzButtonEdit1.Text <>'' then
begin
    if (ExtractFileExt(RzButtonEdit1.Text)<>'.xls')   then
    begin
      MessageDlg('請選擇要導入的Excel檔案!',mtWarning,[mbOK],0);
      RzButtonEdit1.Clear;
    end
    else
    begin try Application.ProcessMessages; ExcelApp:=CreateOleObject('Excel.Application');
        WorkBook:=ExcelApp.WorkBooks.Open(RzButtonEdit1.Text);
        ExcelApp.Visible:=False;
        ExcelSheetCount:=WorkBook.WorkSheets.Count;
        for i:=1 to ExcelSheetCount do
        begin
          Screen.Cursor:=crSQLWait;
          WorkBook.WorkSheets[i].Activate;
          a:=ExcelApp.Cells[4,2].Value;
          b:=ExcelApp.Cells[8,2].Value;
          c:=ExcelApp.Cells[14,2].Value;
          d:=ExcelApp.Cells[21,2].Value;
          e:=ExcelApp.Cells[22,2].Value;
          f:=ExcelApp.Cells[23,2].Value;
          if ((Copy(Trim(a),1,3)<>'ECR') and (b<>'')) and ((Copy(Trim(a),1,3)<>'DCR') and (b<>'')) then
          begin
            MessageDlg('檔案格式錯誤!',mtWarning,[mbOK],0);
            InsertErrorLOG;
            Screen.Cursor:=crDefault;
            Exit;
          end;

          with adoq_ecrn do
          begin
            Close;
            SQL.Text:='select * from RES_ECR_TYPE where ECRNO='''+ a+'''';
            Open;
            if RecordCount=1 then
            begin
              MessageDlg('請檢查:導入檔案時編號"'+ a+'"的記錄重復!',mtWarning,[mbOK],0);
              InsertRepeatLOG;
              Screen.Cursor:=crDefault;
              Exit;
            end;
          end;

           with adoq_ecrn do
           begin
             Close;
             SQL.Clear;
             SQL.Add('insert into RES_ECR_TYPE(ECRNO,DESOFCHANGE,RELEASEDATE,RESPEOPLE,ISSUEDEPT,MODEL) values(:a,:b,:c,:d,:e,:f)');
             Parameters.ParamByName('a').Value:=a;
             Parameters.ParamByName('b').Value:=b;
             Parameters.ParamByName('c').Value:=Trim(Copy(c,1,19));
             Parameters.ParamByName('d').Value:=d;
             Parameters.ParamByName('e').Value:=e;
             Parameters.ParamByName('f').Value:=f;
             ExecSQL;
           end;
           InsertECRLOG;

           ProgressBar1.Min:=0;
           ProgressBar1.Max:=ExcelSheetCount;
           for k:=33 to WorkBook.WorkSheets[i].usedrange.rows.count do
           begin
             g:=ExcelApp.Cells[K,1].Value;
             q:=ExcelApp.Cells[k,2].Value;
             w:=ExcelApp.Cells[k,3].Value;
             v:=ExcelApp.Cells[k,4].Value;
             r:=ExcelApp.Cells[k,5].Value;
             t:=ExcelApp.Cells[k,6].Value;
             y:=ExcelApp.Cells[k,7].Value;
             u:=ExcelApp.Cells[k,8].Value;
             o:=ExcelApp.Cells[k,9].Value;
             if (q<>'')and(w<>'') then
             with adoq_item do
             begin
               Close;
               SQL.Clear;
               SQL.Add('insert into RES_ECR_ITEM(GROUPID,ECRNO,ITEMNO,ITEMDESPTION,FZRELATION,CHANGETYPE,BEFORECHANGE,AFTERCHANGE,PROPOSE,REMARK) values(:g,:p,:q,:w,:v,:r,:t,:y,:u,:o)');
               Parameters.ParamByName('g').Value:=g;
               Parameters.ParamByName('p').Value:=a;
               Parameters.ParamByName('q').Value:=q;
               Parameters.ParamByName('w').Value:=w;
               Parameters.ParamByName('v').Value:=v;
               Parameters.ParamByName('r').Value:=r;
               Parameters.ParamByName('t').Value:=t;
               Parameters.ParamByName('y').Value:=y;
               Parameters.ParamByName('u').Value:=u;
               Parameters.ParamByName('o').Value:=o;
               ExecSQL;
               ProgressBar1.Position:=ProgressBar1.Position+1;
             end;
           end;
           Screen.Cursor:=crDefault;
           Application.ProcessMessages;
           ProgressBar1.Position:=0;
           RefreshECRN;
           RefreshGroupItem;
           SendToEmail;
           Zt:=1;
         end;
      finally
        ExcelApp.ActiveWorkBook.Saved:=True;
        WorkBook.Close;
        ExcelApp.Quit;
      end;
     end;
end
else
begin
    MessageDlg('請選擇要導入的Excel檔案!',mtWarning,[mbOK],0);
    Exit;
end;
end;