unit1.pas

txt 和 excel格式的文件的相互转换

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,ComObj, OleServer,excel97,excel2000, ExtCtrls, Buttons;

type
  TForm1 = class(TForm)
    odgExcel: TOpenDialog;
    odgTxt: TOpenDialog;
    edtTxt: TEdit;
    edtExcel: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Image1: TImage;
    Image2: TImage;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Image3: TImage;
    Image4: TImage;
    Button4: TButton;
    labMessage: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure btnToExcelClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure BtnToTxtClick(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  function SplitString(const Source,ch:String):TStringList;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if odgTxt.Execute then

   edtTxt.Text  := odgTxt.FileName;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if odgExcel.Execute then

   edtExcel.Text  := odgExcel.FileName;
end;

function SplitString(const Source,ch:String):TStringList;
var
temp:String;
i:Integer;
begin
Result:=TStringList.Create;
//如果是空自符串则返回空列表
if Source=''
then exit;
temp:=Source;
i:=pos(ch,Source);
while i<>0 do
begin
     Result.add(copy(temp,0,i-1));
     Delete(temp,1,i);
     i:=pos(ch,temp);
end;
Result.add(temp);
end;



procedure TForm1.btnToExcelClick(Sender: TObject);
var
  s:TStringList;

  ColStrList:    TStringList;

  sheet,XLApp,workbook : variant;
  Row,Col,I,J:integer;

  RowStr:string;

  str:string;

begin

  s:=TStringList.Create;
  s.LoadFromFile(edtTxt.Text );   //读文件

  labMessage.Visible :=true;
  try
    try

      //创建对象
      XLApp:=createOleObject('Excel.Application');
      XLApp.displayAlerts:=false;
      XLApp.ScreenUpdating:=false;

      if  not fileexists(edtExcel.Text) then
      begin
        workbook:=XLApp.WorkBooks.Add();
        workbook.SaveAs(edtExcel.Text);
        sheet:=workbook.worksheets[1];
      end
      else
      begin
        //XLApp.WorkBooks.Open(edtExcel.Text);
        //workbook := XLApp.workbooks[1];
        //sheet:=workbook.worksheets[1];

        workbook:=XLApp.WorkBooks.Add();
        workbook.SaveAs(edtExcel.Text);
        sheet:=workbook.worksheets[1];
      end;

      if (s.Count>0) then
      begin
        Row:=s.Count;
        RowStr:=s.Strings[0];
        ColStrList:=SplitString(RowStr,'|');
        Col:=ColStrList.Count;

        for i:=0 to Row-1 do
        begin
           RowStr:=s.Strings[i];
           ColStrList:=SplitString(RowStr,'|');
           for j:=0 to Col-1 do
           begin
              sheet.cells[i+1,j+1].NumberFormatLocal:='@';
              sheet.cells[i+1,j+1]:= ColStrList.Strings[j];
           end;
           labMessage.Caption:='成功转换txt文件'+inttostr(i+1)+'行到Excel文件';
           application.HandleMessage;

        end ;
      end ;

        labMessage.Visible :=false;
      MessageDlg('转换txt文件到Excel文件成功', mtInformation,[mbOk], 0);
    except
      MessageDlg('转换txt文件到Excel文件失败', mtInformation,[mbOk], 0);
    end
  finally
    if  not fileexists(edtExcel.Text) then
    begin
      workbook.SaveAS(edtExcel.Text);
    end
    else
    begin
      workbook.Save;
    end;
    s.Free;
    if not VarIsEmpty(XLApp) then
    begin  //释放对象
      XLApp.displayAlerts:=false;
      XLApp.ScreenUpdating:=true;
      workbook.close;
      XLApp.quit;
    end;


 end;
end;



procedure TForm1.Button3Click(Sender: TObject);
begin
       MessageDlg('2008-07-23 by gjung'+#13#10+'Email:[e-mail]'+#13#10+'QQ:7525450', mtInformation,[mbOk], 0);
end;

procedure TForm1.BtnToTxtClick(Sender: TObject);
var
  s:TStringList;

  ColStrList:    TStringList;



  sheet,XLApp,workbook : variant;
  Row,Col,I,J:integer;

  RowStr:string;

  str:string;

begin

  s:=TStringList.Create;
  s.Clear;

  labMessage.Visible :=true;
  try

    try
      //创建对象
      XLApp:=createOleObject('Excel.Application');
      XLApp.displayAlerts:=false;
      XLApp.ScreenUpdating:=false;

      if  not fileexists(edtExcel.Text) then
      begin
        //XLApp.WorkBooks.Add();
        //workbook := XLApp.workbooks[1];
        //sheet:=workbook.worksheets[1];
        MessageDlg('Excel文件不存在', mtInformation,[mbOk], 0);
        exit;
      end
      else
      begin
        XLApp.WorkBooks.Open(edtExcel.Text);
        workbook := XLApp.workbooks[1];
        sheet:=workbook.worksheets[1];
      end;

        i:=1;
        //取得列数，根据标题取得
        j:=1;
        col:=0;
        while  (vartostr(sheet.cells[i,j].value)<>'') do
        begin
           j:=j+1;
           col:=col+1;
        end;

        while  (vartostr(sheet.cells[i,1].value)<>'') do
        begin
           RowStr:='';
           for j:=1 to col do
           begin
              RowStr:=RowStr+vartostr(sheet.cells[i,j].value)+'|';
           end;

           //if  (length(RowStr)>0) then
           //begin
             //RowStr:=copy(RowStr,1,length(RowStr)-1);
           //end;

           s.Add(RowStr);
           i:=i+1;

           labMessage.Caption:='成功转换Excel文件'+inttostr(i)+'行到txt文件';
           application.HandleMessage;

        end;

        labMessage.Visible :=false;

        MessageDlg('转换Excel文件到txt文件成功', mtInformation,[mbOk], 0);
    except
        MessageDlg('转换Excel文件到txt文件失败', mtInformation,[mbOk], 0);
    end;
  finally
    s.SaveToFile(edtTxt.Text);
    s.Free;
    if not VarIsEmpty(XLApp) then
    begin  //释放对象
      XLApp.displayAlerts:=false;
      XLApp.ScreenUpdating:=true;
      workbook.close;
      XLApp.quit;
    end;


 end;
end;


procedure TForm1.Button4Click(Sender: TObject);
begin
  close;
end;

end.