excel to delphi.txt

Delphi中将Excel表格中的数据按设定格式输出到Delphi数据库中

Delphi从EXCEL中导入数据
procedure TFrmImportExcel.FlatButton5Click(Sender: TObject);
var
  i,j: integer;
  XLApp,sheet:Variant;
  F: File;
  AllFileName ,FilePath ,FileName ,FileExt :string;
  FullNamestr ,SurNameStr,GivenNameStr,DateOfBidhStr,NationalityStr :string;
begin
  AllFileName :='';
  if FindProcess('EXCEL.EXE') then
  begin
    if MsShow('检测到打开了Excel,是否让其关闭?',2)<>6 then Exit;
    EndProcess('EXCEL.EXE');
  end;
  if FlatSpinEditInteger1.Value <=0 then
  begin
    MsShow('请输入要导入的记录数!');
    Exit;
  end;
  if BeginRow.Value <=0 then
  begin
    MsShow('请输入开始导入的行号!');
    Exit;
  end;
  AllFileName :=FileListBox1.FileName;
  if Trim(AllFileName)='' then
  begin
    MsShow('请选择Excel表格!');
    Exit;
  end;
  Try
    SaveToSQL(AllFileName);
    FileName :=ExtractFileName(AllFileName);
    FilePath :=ExtractFilePath(AllFileName);
    FileExt  :=ExtractFileExt(AllFileName);
  Except
    Msshow('Excel文件保存在数据库失败！');
    Exit;
  end;
  if GroupD.RecordCount>0  then
  begin
    if MsShow('是否删原来的记录,重新导入?',2)<>6 then exit ;
    DelGroupD;
  end;
  try
    xlApp:=CreateOleObject('Excel.Application');
  except
    xlApp:=UnAssigned;
    MsShow('创建Excel实例失败,请重新安装Office 2000!');
    Exit;
  end;
  try
    xlApp.Workbooks.Open(AllFileName);
  except
    MsShow ('打开Excel文档失败!');
    xlApp.Quit;
    xlApp:=UnAssigned;
    Exit;
  end;
  Sheet:=xlApp.WorkBooks[1].WorkSheets[1]; //连接Sheet
  i :=BeginRow.Value;
  j :=FlatSpinEditInteger1.Value+BeginRow.Value ;
  try
    while i<=j do
    begin
      if trim(Sheet.cells.item[i,1])<>'' then
        begin
          GroupD.Insert;
          GroupD.FieldByName('Item_No').AsInteger :=GroupD.RecordCount +1;
          GroupD.fieldbyname('Single_No').AsString  := GroupM.fieldbyname('Single_No').AsString;
          GroupD.FieldByName('ShipTicketNo').asstring :=GroupD.fieldbyname('Single_No').AsString+'-'+inttostr(GroupD.RecordCount+1);
          GroupD.FieldbyName('UserName').asstring :=UserName ;
          GroupD.FieldByName('Luggage').AsInteger :=0;
          GroupD.FieldByName('Weight').AsInteger :=0;
          GroupD.FieldByName('IsThrough').AsBoolean :=False  ;
          GroupD.FieldByName('ischk').AsBoolean :=False ;
          GroupD.FieldByName('IsLeave').AsBoolean :=False ;
          GroupD.FieldByName('E_Ticket').AsBoolean :=False ;
          GroupD.FieldByName('Cons').AsBoolean :=False ;
          GroupD.fieldbyname('OriDate').AsString  := GroupM.fieldbyname('OriDate').AsString;
          GroupD.fieldbyname('OriHB').AsString  := GroupM.fieldbyname('OriHB').AsString;
          GroupD.fieldbyname('Camer').AsString  := GroupM.fieldbyname('Camer').AsString;
          GroupD.fieldbyname('FlightNo').AsString  := GroupM.fieldbyname('FlightNo').AsString;
          GroupD.fieldbyname('Origin').AsString  := GroupM.fieldbyname('Origin').AsString;
          GroupD.fieldbyname('Dest').AsString  := GroupM.fieldbyname('Dest').AsString;
          GroupD.fieldbyname('Type').AsString  := GroupM.fieldbyname('Type').AsString;
          GroupD.fieldbyname('Ticket').AsString  := GroupM.fieldbyname('Ticket').AsString;
          GroupD.fieldbyname('U_Price').AsString  := GroupM.fieldbyname('U_Price').AsString;
  ////////分解姓名 begin ///////////////////////////////////////
          if Unite.Checked then
            begin
              FullNamestr :=Trim(Sheet.Cells.Item[i,CharToInt2(SurName.text)]);
              SurNameStr :=Copy(FullNamestr,0,pos(' ',FullNamestr)-1);
              GivenNameStr :=Trim(Copy(FullNamestr,pos(' ',FullNamestr)+1,Length(FullNamestr)));
            end
          else
            begin
              SurNameStr :=Trim(Sheet.Cells.Item[i,CharToInt2(SurName.text)]);
              GivenNameStr :=Trim(Sheet.Cells.Item[i,CharToInt2(GivenName.text)]);
            end;
          if SurNameStr='' then
            GroupD.fieldbyname('SurName').AsString :='??????'
          else
            GroupD.fieldbyname('SurName').value:=SurNameStr;
          if GivenNameStr='' then
            GroupD.fieldbyname('GivenName').AsString :='??????'
          else
            GroupD.FieldByName('GivenName').value :=GivenNameStr;
  //////////分解姓名 END ///////////////////////////////////////////////////
          if Trim(Sheet.Cells.Item[i,CharToInt2(PassportNo.text)])='' then
            GroupD.fieldbyname('PassportNo').AsString :='??????'
          else
          GroupD.FieldByName('PassportNo').value :=Sheet.Cells.Item[i,CharToInt2(PassportNo.text)];
  //////////自动转换日期格式 BEGIN ///////////////////////////////////////////////////
          DateOfBidhStr :=Trim(Sheet.Cells.Item[i,CharToInt2(DateOfBidh.text)]);
          //DateOfBidhStr :=AnsiReplaceStr(trim(DateOfBidhStr),Separator.Text,'-') ;
          try
            GroupD.fieldbyname('DateOfBidh').value :=strtodate(ChangeDateFormat(DateOfBidhStr));
          except
            GroupD.fieldbyname('DateOfBidh').value :='1900-01-01';
          end;
  //////////自动转换日期格式 END ///////////////////////////////////////////////////
          if Trim(Sheet.Cells.Item[i,CharToInt2(Nationality.text)])='' then
            GroupD.fieldbyname('Nationality').AsString :=FlatComboBox4.Text
          else
            GroupD.FieldByName('Nationality').value :=Sheet.Cells.Item[i,CharToInt2(Nationality.text)];
          GroupD.Post;
        end ;
        Inc(i);
    end;
  finally
    Msshow('数据导入完毕！');
  end;
  try
    xlApp.Quit;
    Sheet :=Unassigned ;
    xlApp:=Unassigned;
  except
  end;
  //EndProcess('excel.exe');
  AssignFile(F,AllFileName); // 将C:\MyFile.txt文件与F变量建立连接，后面可以使用F变量对文件进行操作。
  Rename(F,FilePath+'已导_'+FileName);
  FileListBox1.Update;

end;