asked on

limit text to 200 words - or - how do I remove the last word in a Word document

I'm actually using Excel to populate a Word document in order to count the words in a text field. I want to return only 200 words from the Word document to the Excel VBA. I'm attaching what I have already. The problem seems to be that "oSelection.Range.Words.last.Delete " doesn't do what I think it should. Is this the proper usage or is there another/better way to do this?

Thanks

' Excel 2002 Code
' --------------------
Dim oWord As Object
Dim oWordDocument As Object
Dim oSelection As Object

Set oWord = CreateObject("Word.application")
oWord.Visible = True
Set oWordDocument = oWord.documents.Add
Set oSelection = oWord.Selection
oSelection.typetext Trim(Cells(Selection.Row, iColumnToLimitWords).Value)

oSelection.WholeStory

' loop counting the words and then deleting one word at a time until the limit is reached
Do While oWord.ActiveDocument.Range.ComputeStatistics(0) >= iNumberOfWordsAllowed
    oSelection.WholeStory
    
    oSelection.Range.Words.last.Delete  ' THIS LINE SEEMS TO DO NOTHING

Loop

oWordDocument.Selection.WholeStory
oWordDocument.Selection.Copy

Cells(Selection.Row, iColumnToLimitWords).Value = ActiveWorkbook.Paste

Open in new window

Tommy Kinard

I would reccomend that you do this, limit the information being sent to Word, only send 200 words.

HTH
dragontooth

Function KillGT200(Info As Variant) As String
    Dim HldData() As String
    HldData = Split(Trim(CStr(Info)), " ")
    If UBound(HldData, 1) > 200 Then ReDim Preserve HldData(200)
    KillGT200 = Join(HldData, " ")
End Function

usage:
oSelection.typetext KillGT200(Cells(Selection.Row, iColumnToLimitWords).Value)

Open in new window

GordJones

ASKER

This has flaws in that when a sentence ends and a new one begins they could all be considered 1 word. The following example would only have 3 words since there are no spaces between "end.New"... only a special character of a linefeed:
The end.
New sentence.

Tommy Kinard

This should fix you right up.

dragontooth

Do While oWord.ActiveDocument.Range.ComputeStatistics(0) >= iNumberOfWordsAllowed
    oSelection.WholeStory
     
 oSelection.Collapse Direction:=wdCollapseEnd

    oSelection.MoveEnd Unit:=wdWord, Count:=-1
    oSelection.Delete Unit:=wdWord, Count:=1
Loop

Open in new window

SOLUTION

Tommy Kinard

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

GordJones

ASKER

works great but one problem :(
Selection.MoveEnd Unit:=wdWord, Count:=-(mI - 200)
This line is doing a "Words" count instead of using the "ComputeStatistics(0)" words count :( So it is gettings special characters, etc included and ending up with more than 200 "real" words.

GrahamSkan

Yes. ComputeStatistics(0) returns a number less than the Words collection count.

A paragraph with date: "07/01/10¶" counts as six in the Words collection, but is only one in ComputeStatistics(0).

Also the last paragraph cannot be deleted.

See if this helps

Sub TwoHundredWords()
    Dim rng As Range
    Dim rng2 As Range
    
    Do Until ActiveDocument.Range.ComputeStatistics(0) <= 200
        Set rng = ActiveDocument.Range
        Set rng2 = rng.Words.Last
        Do While rng2.Text = Chr$(13)
            rng.End = rng2.Start
            Set rng2 = rng.Words.Last
            rng2.Delete
        Loop
    Loop
 End Sub

Open in new window

GordJones

ASKER

That worked great!
Now hopefully the final problem... when I paste back into Excel, and the text contains paragraphs, the text is ending up in 2 cells instead of all in one as I would like it. Example:
"This is a test.

This is the second paragraph. "
When this Word text is pasted back into Excel each paragraph is inserted on a separate row :( How can I force Excel to past all the text into a single cell?

ASKER CERTIFIED SOLUTION

GrahamSkan

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

GordJones

ASKER

That's what I'm looking for, thanks. I'll be taking it a step furtur and instead of relacing with a space, I'll replace with my own special character. Then once the text is in the Excel cell I'll replace it back into being a paragraph break :)