delphi--csv,txt文本转换成excel .

由于系统使用导出的格式是csv,但是如果数字的长度太长的话,用excle打开会用科学技术法自动截断了。所以开发了一个转换程序。

[java]view plaincopyprint?

  1. unit Unit1;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  5. Dialogs, StdCtrls, ExtCtrls, ComCtrls, ComObj, StrUtils, WinSkinData,
  6. WinSkinStore, Gauges, ShellApi, ClipBrd;
  7. type
  8. TForm1 = class(TForm)
  9. OpenDialog1: TOpenDialog;
  10. SaveDialog1: TSaveDialog;
  11. Panel1: TPanel;
  12. Edit1: TEdit;
  13. Edit2: TEdit;
  14. Button1: TButton;
  15. Button2: TButton;
  16. Button3: TButton;
  17. StatusBar1: TStatusBar;
  18. SkinData1: TSkinData;
  19. Timer1: TTimer;
  20. Gauge1: TGauge;
  21. progressBar: TProgressBar;
  22. procedure Button1Click(Sender: TObject);
  23. procedure Button2Click(Sender: TObject);
  24. procedure Button3Click(Sender: TObject);
  25. procedure FormPaint(Sender: TObject);
  26. procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
  27. Panel: TStatusPanel; const Rect: TRect);
  28. procedure FormCreate(Sender: TObject);
  29. procedure Timer1Timer(Sender: TObject);
  30. private
  31. progressBarRect:TRect; // 进度条组件的尺寸
  32. public
  33. { Public declarations }
  34. procedure DropFiles(var Message: TMessage); message WM_DropFiles;
  35. end;
  36. var
  37. Form1: TForm1;
  38. implementation
  39. {$R *.dfm}
  40. procedure TForm1.DropFiles(var Message: TMessage);
  41. var
  42. i,l: Integer;
  43. p: array[0..254] of Char;
  44. s: String;
  45. begin
  46. i := DragQueryFile(Message.wParam, $FFFFFFFF, nil, 0);
  47. for i := 0 to i - 1 do begin
  48. DragQueryFile(Message.wParam, i, p, 255);
  49. //ShowMessage(StrPas(p));
  50. s := StrPas(p);
  51. l := Pos('.csv',s);
  52. if (l > 0) then
  53. Edit1.Text := StrPas(p)
  54. else
  55. ShowMessage('请选择csv文件!');
  56. end;
  57. end;
  58. procedure TForm1.Button1Click(Sender: TObject);
  59. begin
  60. StatusBar1.Panels[0].Text :='';
  61. OpenDialog1.Execute;
  62. Edit1.Text := OpenDialog1.FileName;
  63. end;
  64. procedure TForm1.Button2Click(Sender: TObject);
  65. begin
  66. StatusBar1.Panels[0].Text:='';
  67. SaveDialog1.Execute;
  68. Edit2.Text := SaveDialog1.FileName;
  69. end;
  70. procedure TForm1.Button3Click(Sender: TObject);
  71. var
  72. Excel,WorkBook,xlQuery,A:Variant;
  73. f:TextFile;
  74. i,j,k,b,nLen:integer;
  75. s,xlsFile:string;
  76. pc:PChar;
  77. StepCount : Integer;
  78. vSL: TStringList;
  79. begin
  80. try
  81. if not FileExists(Edit1.Text) then
  82. begin
  83. StatusBar1.Panels[0].Text:='请选择CSV文件!!!!!!!';
  84. exit;
  85. end;
  86. xlsFile := Edit1.Text;
  87. xlsFile := AnsiReplaceText(xlsFile,'.csv','.xls');
  88. if xlsFile = '' then
  89. begin
  90. StatusBar1.Panels[0].Text:='请选择另存为Excel!!!!!!!';
  91. Exit;
  92. end;
  93. //AssignFile(f,Edit1.Text);
  94. //Reset(f);
  95. vSL := TStringList.Create;
  96. //vSL.Delimiter=',';
  97. vSL.LoadFromFile(Edit1.Text);
  98. try
  99. Excel:=CreateOleObject('Excel.Application');
  100. WorkBook:=CreateOleobject('Excel.Sheet');
  101. except
  102. ShowMessage('您的机器里未安装Microsoft Excel.');
  103. Exit;
  104. end;
  105. //动态创建进度条组件progressBar
  106. StepCount:=vSL.Count; // 循环的总数目
  107. timer1.Enabled:=true;
  108. with progressBar do
  109. begin
  110. // 先确定进度条组件的尺寸和位置
  111. Top:=ProgressBarRect.Top;
  112. Left:=ProgressBarRect.Left;
  113. Width:=ProgressBarRect.Right-ProgressBarRect.Left;
  114. Height:=ProgressBarRect.Bottom-ProgressBarRect.Top;
  115. Parent:=StatusBar1; // parent属性设置为状态栏组件
  116. Visible:=True; // 使进度条可见
  117. Min:=0;// 设定进度条的范围和步长
  118. Max:=StepCount div 300;
  119. Step:=1;
  120. end;
  121. //pb.Visible := true;
  122. WorkBook := Excel.workbooks.add;
  123. Excel.worksheets[1].activate;
  124. Excel.Visible:=false;
  125. // Clipboard.AsText:=vSL.Text;
  126. //计算有多少列
  127. s:=vSL[0];
  128. pc := PChar(s);
  129. k:=0;
  130. b:=1;
  131. j:=1;
  132. nLen := strlen(pc);
  133. while k<nLen do
  134. begin;
  135. if pc[k] = ',' then
  136. begin
  137. inc(j);
  138. end;
  139. inc(k);
  140. end;
  141. A:=VarArrayCreate([0,j],varVariant);
  142. for i:=0 to j do
  143. A[i]:=2;
  144. xlQuery := Excel.worksheets[1].QueryTables.Add('TEXT;'+Edit1.Text,Excel.worksheets[1].Range['A1']);
  145. //xlQuery.Name := '';
  146. xlQuery.FieldNames := True;
  147. xlQuery.RowNumbers := False;
  148. xlQuery.FillAdjacentFormulas := False;
  149. xlQuery.PreserveFormatting := True;
  150. xlQuery.RefreshOnFileOpen := False;
  151. //xlQuery.RefreshStyle := 'xlInsertDeleteCells';
  152. xlQuery.SavePassword := False;
  153. xlQuery.SaveData := True;
  154. xlQuery.AdjustColumnWidth := True;
  155. xlQuery.RefreshPeriod := 0;
  156. xlQuery.TextFilePromptOnRefresh := False;
  157. xlQuery.TextFilePlatform := 936;
  158. xlQuery.TextFileStartRow := 1;
  159. //xlQuery.TextFileParseType := 'xlDelimited';
  160. //xlQuery.TextFileTextQualifier := 'xlTextQualifierDoubleQuote';
  161. xlQuery.TextFileConsecutiveDelimiter := False;
  162. xlQuery.TextFileTabDelimiter := False;
  163. xlQuery.TextFileSemicolonDelimiter := False;
  164. xlQuery.TextFileCommaDelimiter := True;
  165. xlQuery.TextFileSpaceDelimiter := False;
  166. xlQuery.TextFileColumnDataTypes := A;
  167. xlQuery.TextFileTrailingMinusNumbers := True;
  168. xlQuery.Refresh;
  169. if FileExists(xlsFile) then
  170. DeleteFile(xlsFile);
  171. // Excel.worksheets[1].Paste;
  172. WorkBook.SaveAs(xlsFile);
  173. StatusBar1.Panels[0].Text:='转换成功!!!!!!!';
  174. progressBar.Visible:=false;
  175. finally
  176. if vSL<>nil then
  177. vSL.Free;
  178. if not VarIsEmpty(WorkBook) then WorkBook.close;
  179. if not VarIsEmpty(Excel) then Excel.quit;
  180. //if not VarIsEmpty(A) then varfree(A);
  181. timer1.Enabled:=false;
  182. end;
  183. end;
  184. procedure TForm1.FormPaint(Sender: TObject);
  185. begin
  186. StatusBar1.Panels[0].Text:='中国建设银行版权所有..........';
  187. end;
  188. procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
  189. Panel: TStatusPanel; const Rect: TRect);
  190. begin
  191. progressBarRect:=Rect;
  192. end;
  193. procedure TForm1.FormCreate(Sender: TObject);
  194. begin
  195. DragAcceptFiles(Handle, True);
  196. end;
  197. procedure TForm1.Timer1Timer(Sender: TObject);
  198. begin
  199. progressBar.Stepit;
  200. //Application.ProcessMessages;
  201. //Sleep(ProgressBar.Position);
  202. end;
  203. end.
unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ExtCtrls, ComCtrls, ComObj, StrUtils, WinSkinData,

  WinSkinStore, Gauges, ShellApi, ClipBrd;



type

  TForm1 = class(TForm)

    OpenDialog1: TOpenDialog;

    SaveDialog1: TSaveDialog;

    Panel1: TPanel;

    Edit1: TEdit;

    Edit2: TEdit;

    Button1: TButton;

    Button2: TButton;

    Button3: TButton;

    StatusBar1: TStatusBar;

    SkinData1: TSkinData;

    Timer1: TTimer;

    Gauge1: TGauge;

    progressBar: TProgressBar;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure FormPaint(Sender: TObject);

    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;

      Panel: TStatusPanel; const Rect: TRect);

    procedure FormCreate(Sender: TObject);

    procedure Timer1Timer(Sender: TObject);

  private

    progressBarRect:TRect; // 进度条组件的尺寸

  public

    { Public declarations }

    procedure   DropFiles(var   Message:   TMessage);   message   WM_DropFiles;

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



procedure   TForm1.DropFiles(var   Message:   TMessage);  

  var  

      i,l:   Integer;

      p:   array[0..254]   of   Char;

      s:   String;

  begin

      i   :=   DragQueryFile(Message.wParam,   $FFFFFFFF,   nil,   0);  

      for   i   :=   0   to   i   -   1   do   begin  

          DragQueryFile(Message.wParam,   i,   p,   255);  

          //ShowMessage(StrPas(p));

          s :=  StrPas(p);

          l := Pos('.csv',s);

          if (l > 0) then

            Edit1.Text := StrPas(p)

          else

            ShowMessage('请选择csv文件!');

      end;  

  end;   



procedure TForm1.Button1Click(Sender: TObject);

begin

StatusBar1.Panels[0].Text :='';

OpenDialog1.Execute;

Edit1.Text := OpenDialog1.FileName;

end;



procedure TForm1.Button2Click(Sender: TObject);

begin

StatusBar1.Panels[0].Text:='';

SaveDialog1.Execute;

Edit2.Text := SaveDialog1.FileName;

end;



procedure TForm1.Button3Click(Sender: TObject);

var

  Excel,WorkBook,xlQuery,A:Variant;

  f:TextFile;

  i,j,k,b,nLen:integer;

  s,xlsFile:string;

  pc:PChar;

  StepCount : Integer;

  vSL:   TStringList;

begin

    try

          if   not   FileExists(Edit1.Text)   then

          begin

             StatusBar1.Panels[0].Text:='请选择CSV文件!!!!!!!';

             exit;

          end;

          xlsFile := Edit1.Text;

          xlsFile := AnsiReplaceText(xlsFile,'.csv','.xls');

          if xlsFile = '' then

          begin

             StatusBar1.Panels[0].Text:='请选择另存为Excel!!!!!!!';

             Exit;

          end;

          //AssignFile(f,Edit1.Text);

          //Reset(f);

          vSL   :=   TStringList.Create;

          //vSL.Delimiter=',';

          vSL.LoadFromFile(Edit1.Text);

          try

            Excel:=CreateOleObject('Excel.Application');

            WorkBook:=CreateOleobject('Excel.Sheet');

          except

            ShowMessage('您的机器里未安装Microsoft Excel.');

            Exit;

          end;

          //动态创建进度条组件progressBar



          StepCount:=vSL.Count; // 循环的总数目

          timer1.Enabled:=true;

          with progressBar do

          begin

          // 先确定进度条组件的尺寸和位置

          Top:=ProgressBarRect.Top;

          Left:=ProgressBarRect.Left;

          Width:=ProgressBarRect.Right-ProgressBarRect.Left;

          Height:=ProgressBarRect.Bottom-ProgressBarRect.Top;

          Parent:=StatusBar1; // parent属性设置为状态栏组件

          Visible:=True; // 使进度条可见          

          Min:=0;// 设定进度条的范围和步长

          Max:=StepCount div 300;

          Step:=1;

          end;

          //pb.Visible := true;

          WorkBook := Excel.workbooks.add;

          Excel.worksheets[1].activate;

          Excel.Visible:=false;

//          Clipboard.AsText:=vSL.Text;

          //计算有多少列

          s:=vSL[0];

          pc := PChar(s);

          k:=0;

          b:=1;

          j:=1;

          nLen := strlen(pc);

          while k<nLen do

              begin;

                if pc[k] = ',' then

                begin

                  inc(j);

                end;

                inc(k);

          end;



        A:=VarArrayCreate([0,j],varVariant);

        for   i:=0   to   j   do

             A[i]:=2;



        xlQuery := Excel.worksheets[1].QueryTables.Add('TEXT;'+Edit1.Text,Excel.worksheets[1].Range['A1']);

        //xlQuery.Name := '';

        xlQuery.FieldNames := True;

        xlQuery.RowNumbers := False;

        xlQuery.FillAdjacentFormulas := False;

        xlQuery.PreserveFormatting := True;

        xlQuery.RefreshOnFileOpen := False;

        //xlQuery.RefreshStyle := 'xlInsertDeleteCells';

        xlQuery.SavePassword := False;

        xlQuery.SaveData := True;

        xlQuery.AdjustColumnWidth := True;

        xlQuery.RefreshPeriod := 0;

        xlQuery.TextFilePromptOnRefresh := False;

        xlQuery.TextFilePlatform := 936;

        xlQuery.TextFileStartRow := 1;

        //xlQuery.TextFileParseType := 'xlDelimited';

        //xlQuery.TextFileTextQualifier := 'xlTextQualifierDoubleQuote';

        xlQuery.TextFileConsecutiveDelimiter := False;

        xlQuery.TextFileTabDelimiter := False;

        xlQuery.TextFileSemicolonDelimiter := False;

        xlQuery.TextFileCommaDelimiter := True;

        xlQuery.TextFileSpaceDelimiter := False;

        xlQuery.TextFileColumnDataTypes := A;

        xlQuery.TextFileTrailingMinusNumbers := True;

        xlQuery.Refresh;

          if   FileExists(xlsFile)   then

              DeleteFile(xlsFile);

//          Excel.worksheets[1].Paste;

          WorkBook.SaveAs(xlsFile);

          StatusBar1.Panels[0].Text:='转换成功!!!!!!!';

          progressBar.Visible:=false;

    finally

      if   vSL<>nil then

        vSL.Free;

      if not VarIsEmpty(WorkBook) then WorkBook.close;

      if not VarIsEmpty(Excel) then Excel.quit;

      //if not VarIsEmpty(A) then varfree(A);

      timer1.Enabled:=false;

    end;

end;



procedure TForm1.FormPaint(Sender: TObject);

begin

StatusBar1.Panels[0].Text:='中国建设银行版权所有..........';



end;



procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;

  Panel: TStatusPanel; const Rect: TRect);

begin

progressBarRect:=Rect;

end;



procedure TForm1.FormCreate(Sender: TObject);

begin

DragAcceptFiles(Handle,   True);

end;



procedure TForm1.Timer1Timer(Sender: TObject);

begin

     progressBar.Stepit;     

          //Application.ProcessMessages;

          //Sleep(ProgressBar.Position);

end;



end.

原来使用的是

[csharp]view plaincopyprint?

  1. for i:=1 to StepCount do
  2. begin
  3. //Readln(f,s);
  4. progressBar.Stepit;// 循环使进度显示条累加
  5. s:=vSL[i-1];
  6. pc := PChar(s);
  7. k:=0;
  8. b:=1;
  9. j:=0;
  10. nLen := strlen(pc);
  11. while k<nLen do
  12. begin;
  13. if pc[k] = ',' then
  14. begin
  15. inc(j);
  16. Excel.cells[i,j].NumberFormat:='@';
  17. Excel.cells[i,j].value:=Copy(s,b,k-b+1);
  18. b:=k+2;
  19. end;
  20. inc(k);
  21. end;
  22. inc(j);
  23. Excel.cells[i,j].NumberFormat:='@';
  24. Excel.cells[i,j].value:=Copy(s,b,k-b+1);
  25. end;
  26. 上面的代码是遍历整个文件,判断是否有逗号,然后对每个格子插入数据。这样做的效率很低,
  27. 3千多行的数据转换用了5分钟。后来使用vba,先用excle录制了一段外部数据导入的宏。
  28. <PRE class=vb.net name="code">Sub Macro3()
  29. '
  30. ' Macro3 Macro
  31. ' 宏由 ZHL 录制,时间: 2008-7-3
  32. '
  33. '
  34. Cells.Select
  35. With ActiveSheet.QueryTables.Add(Connection:= _
  36. "TEXT;C:/Documents and Settings/zhl/桌面/200807021528053658.csv", Destination:= _
  37. Range("A1"))
  38. .Name = "200807021528053658_1"
  39. .FieldNames = True
  40. .RowNumbers = False
  41. .FillAdjacentFormulas = False
  42. .PreserveFormatting = True
  43. .RefreshOnFileOpen = False
  44. .RefreshStyle = xlInsertDeleteCells
  45. .SavePassword = False
  46. .SaveData = True
  47. .AdjustColumnWidth = True
  48. .RefreshPeriod = 0
  49. .TextFilePromptOnRefresh = False
  50. .TextFilePlatform = 936
  51. .TextFileStartRow = 1
  52. .TextFileParseType = xlDelimited
  53. .TextFileTextQualifier = xlTextQualifierDoubleQuote
  54. .TextFileConsecutiveDelimiter = False
  55. .TextFileTabDelimiter = False
  56. .TextFileSemicolonDelimiter = False
  57. .TextFileCommaDelimiter = True
  58. .TextFileSpaceDelimiter = False
  59. .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
  60. 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
  61. .TextFileTrailingMinusNumbers = True
  62. .Refresh BackgroundQuery:=False
  63. End With
  64. End Sub
  65. 然后根据上面的宏写了如下的delphi代码:
  66. <PRE class=csharp name="code"> xlQuery := Excel.worksheets[1].QueryTables.Add('TEXT;'+Edit1.Text,Excel.worksheets[1].Range['A1']);
  67. //xlQuery.Name := '';
  68. xlQuery.FieldNames := True;
  69. xlQuery.RowNumbers := False;
  70. xlQuery.FillAdjacentFormulas := False;
  71. xlQuery.PreserveFormatting := True;
  72. xlQuery.RefreshOnFileOpen := False;
  73. //xlQuery.RefreshStyle := 'xlInsertDeleteCells';
  74. xlQuery.SavePassword := False;
  75. xlQuery.SaveData := True;
  76. xlQuery.AdjustColumnWidth := True;
  77. xlQuery.RefreshPeriod := 0;
  78. xlQuery.TextFilePromptOnRefresh := False;
  79. xlQuery.TextFilePlatform := 936;
  80. xlQuery.TextFileStartRow := 1;
  81. //xlQuery.TextFileParseType := 'xlDelimited';
  82. //xlQuery.TextFileTextQualifier := 'xlTextQualifierDoubleQuote';
  83. xlQuery.TextFileConsecutiveDelimiter := False;
  84. xlQuery.TextFileTabDelimiter := False;
  85. xlQuery.TextFileSemicolonDelimiter := False;
  86. xlQuery.TextFileCommaDelimiter := True;
  87. xlQuery.TextFileSpaceDelimiter := False;
  88. xlQuery.TextFileColumnDataTypes := A;
  89. xlQuery.TextFileTrailingMinusNumbers := True;
  90. xlQuery.Refresh;</PRE>
  91. 使用excle的导入功能后转换原来的文件之用了10秒钟。</PRE>