一行一行的从WORD中读出文本内容？

[pukerno3]

不要格式信息，但保留空格和换行。

[Billy_Chen28]

procedure TForm1.Button1Click(Sender: TObject);
var
w,r:variant;
begin
w:=unassigned;
w:=createoleobject('word.application');
w.documents.Add('c:\test.doc');
r:=w.documents.item(1).Range;//读取WORD文件第一行
memo1.Lines.Add(r.text);
w.visible :=true;
end;

[sysu]

试试下面这段代码：
procedure InsertText(Pal : string);
//inserta text in Word
var
Sel : Selection;
begin
Sel := Form1.MsWord.Selection;
Sel.TypeText(Pal);
end;

procedure MovePreviousWord;;
var
MoveUnit : OleVariant;
vCount : OleVariant;
Extended : OleVariant;
begin
MoveUnit := wdWord;
vCount := 1;
Extended := unassigned;
Form1.MsWord.Selection.MoveLeft(MoveUnit, vCount, Extended);
end;

procedure MoveNextWord;
//move cursor to next word
var
MoveUnit : OleVariant;
vCount : OleVariant;
Extended : OleVariant;
begin
MoveUnit := wdWord;
vCount := 1;
Extended := unassigned;
Form1.MsWord.Selection.MoveRight(MoveUnit, vCount, Extended);
end;

procedure ReadWord;
//read a word from Word doc
var
Pal : string;
i : integer;
begin
ActRange := Form1.MsWord.Selection.Words.Item(1);
Pal := ActRange;
end;

procedure CountAllWordOnDoc(var Cuenta: integer);
var
Tot : OleVariant;
Total : integer;
begin
Tot := Form1.MsWord.ActiveDocument.Words.Count;
Total := Tot;
Cuenta := Total;
end;

procedure CountWordsHighLighted(var Cuenta : integer);
var
Tot : OleVariant;
Total : integer;
begin
Tot := Form1.MSWord.Selection.Words.Count;
Cuenta := Tot;
end;

procedure HighLightWord;
//HighLight a word
var
MoveUnit : OleVariant;
vCount : OleVariant;
Extended : OleVariant;
begin
MoveUnit := wdWord;
vCount := 1;
Extended := wdExtend;
Form1.MsWord.Selection.MoveRight(MoveUnit, vCount, Extended);
end;

procedure HomeCursor;
//put cursor at the beginning of the document
var
Unidad : OleVariant;
Extended : OleVariant;
begin
Unidad := wdStory;
Extended := Unassigned;
Form1.MsWord.Selection.HomeKey(Unidad,Extended);
end;

procedure TForm1.Button1Click(Sender: TObject);
//check if you can read word by word, from beginning to end of document...
//this test will change all word from lower to UPPER case...
var
Pal : string;
i : integer;
Total : integer;
begin
HomeCursor;
CountAllWordOnDoc(Total);
for i := 1 to Total do
begin
ActRange := MsWord.Selection.Words.Item(1);
if i <> 1 then HighLightWord
else
begin
HomeCursor;
HighLightWord;
end;
Pal := ActRange;
Pal := UpperCase(Pal);
//ShowMessage(Pal);
end;
end;

[linsb]

//显示word中的每一行的内容（以行为单位）
procedure GotoFirstPage(WrdApp: TWordApplication);
var
WdUnit, WdCount, wdExtend: OleVariant;
begin
WdUnit := wdScreen;
wdCount := 10;
wdExtend := EmptyParam;
while true do
if WrdApp.Selection.MoveUp(WdUnit, wdCount, wdExtend) = 0 then break;
end;

procedure TForm1.ShowLineText;
var
n0, n, nn: integer;
WdUnit, WdCount, Extend: OleVariant;
begin
n:=1;
GotoFirstPage(Wordapplication1);
while n > 0 do
begin
n0 := Wordapplication1.Selection.Get_start;
WdUnit := wdLine;
wdCount := 1;
Extend := EmptyParam;
n:=Wordapplication1.Selection.MoveDown(WdUnit, wdCount, Extend);
if n > 0 then
nn := Wordapplication1.Selection.Get_start
else
begin
WordApplication1.ActiveDocument.Select;
nn := Wordapplication1.Selection.Get_End_;
end;
ARange.SetRange(n0, nn);
showmessage(ARange.text);
end;
end