以Delphi 取得Word全部文字

網路上找的一大堆都不能用...

uses
ClipBrd,
ComObj;
 
function ExtractTextFromWordFile(const FileName:string):string;
var
  WordApp    : Variant;
  CharsCount : integer;
begin
  WordApp := CreateOleObject('Word.Application');
  try
    WordApp.Visible := False;
    WordApp.Documents.open(FileName);
    //WordApp.documents.Open(FileName, Revert:=true, Visible := false );
    CharsCount:=Wordapp.Documents.item(1).Characters.Count; //get the number of chars to select
    WordApp.Selection.SetRange(0, CharsCount); //make the selection
    WordApp.Selection.Copy;//copy to the clipboard
    Result:=Clipboard.AsText;//get the text from the clipboard
    WordApp.documents.item(1).Close;
  finally
    WordApp.Quit;
    VarClear(WordApp);
    WordApp:=unassigned;
  end;
end;
 
 
 
//----------使用範例
 

procedure TForm2.Button1Click(Sender: TObject);
var ts,CreateSQL:TStrings;
    i:integer;
    isOnLine:Boolean;
begin
  if not OpenDialog1.Execute then
    Exit;
  mmo1.Lines.Clear;

  ts:=TStringList.Create;
  ts.Text:=ExtractTextFromWordFile(OpenDialog1.FileName);
  //mmo1.Lines.AddStrings(ts);

  CreateSQL:=TStringList.Create;
  isOnLine:=False;
  for I := 0 to ts.Count-1 do
  begin
    if (Pos('SET ANSI_NULLS ON',UpperCase(ts[i]))>0) or
       (Pos('CREATE',UpperCase(ts[i]))>0)
    then begin
      isOnLine:=True;
    end;
    if Trim(ts[i])='' then
    begin
      isOnLine:=false;
      if CreateSQL.Text<>'' then
      begin
        mmo1.Lines.Append('--------');
        mmo1.Lines.AddStrings(CreateSQL);
      end;
      CreateSQL.Clear;
    end;
    if isOnLine then
      CreateSQL.Append(ts[i]);
  end;
  CreateSQL.Free;
  ts.Free;
end;

arrow
arrow
    文章標籤
    Delphi Ole Office Word
    全站熱搜
    創作者介紹
    創作者 抓狂小白 的頭像
    抓狂小白

    抓狂小白的程式筆記

    抓狂小白 發表在 痞客邦 留言(0) 人氣()

    E-mail轉寄