Need Help with Word Find 2

[alwayshouston]

Hi All
I am seeking help to edit my code that finds the word "Status" in a MS Word file controlling from Excel. Once it finds word "status" by itself in the word document, it copies the rest of page and paste it to excel. I have successfully written the code, but my find does not go to next word "status". It simply gets stuck on the first find. Below is my code. Please help me to edit below code.

Thanks in Advance!
Sub CopyFromWord()

Dim wrd As Word.Application
Dim wrdDoc As Word.Document
Dim i As Integer
Set wrd = CreateObject("Word.Application")
wrd.Visible = True
Application.ScreenUpdating = False
'copy open word document to Excel

With Range("A1")
.Formula = "Word Document Contents:"
.Font.Bold = True
.Font.Size = 14
.Offset(1, 0).Select
End With
r = 3 ' startrow for the copied text from the Word document


wrd.Visible = False
wrd.Documents.Open "C:\Foldername\MyNewWordDoc.doc"
Set wrdDoc = wrd.Documents("MyNewWordDoc.doc")

Do Until wrdDoc.Bookmarks("\Sel") = _
wrdDoc.Bookmarks("\EndOfDoc")
wrd.Selection.Find.ClearFormatting
With wrd.Selection.Find
.Text = "Status"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wrd.Selection.Find.Execute

If wrd.Selection.Find.Found = True Then
wrd.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
wrd.Selection.HomeKey Unit:=wdLine
wrd.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
'Checking whether if it is only STATUS in the line
StatusCheck = wrd.Selection.Text
If Trim(StatusCheck) = "Status" Then
' Select the end of the page
wrd.Selection.MoveDown
wrd.Selection.HomeKey Unit:=wdLine
wrd.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Set tRange = wrd.Selection.Range
tRange.SetRange Start:=tRange.Start, End:=wrdDoc.Bookmarks("\Page").Range.End
tString = tRange.Text
ActiveSheet.Range("A" & r).Formula = tString
r = r + 1
End If
Else
Exit Do
End If
Loop
wrd.Quit
Set wrd = Nothing
End Sub

 

[fumei]

Here is code, but from within Word, that does what you want. You can look at it, and adjust your code accordingly.

Sub FromStatusToPageEnd()
Dim r As Range
Dim lngStart As Long
Dim lngEnd As Long
Dim aDoc As Document
Dim newDoc As Document

Set aDoc = ActiveDocument
Application.Documents.Add
Set newDoc = ActiveDocument
aDoc.Activate

Selection.HomeKey Unit:=wdStory
With ActiveDocument.Content.Find
    .ClearFormatting
    Do While .Execute(FindText:="Status", Forward:=True, _
            Format:=True) = True
            Selection.Find.Execute
 ' above makes a selection of the word
 ' check to see if selection length equals
 ' line length,  minus paragraph mark
 
If Selection.Range.End = _
    (ActiveDocument.Bookmarks("\line").Range.End - 1) And _
  Selection.Range.Start = _
    ActiveDocument.Bookmarks("\line").Range.Start Then
            
    lngStart = Selection.Range.Start
    lngEnd = ActiveDocument.Bookmarks("\page").Range.End
Set r = ActiveDocument.Range(Start:=lngStart, End:=lngEnd)
r.Select
    Selection.Copy
    newDoc.Activate
        Selection.Paste
        aDoc.Activate
    Set r = Nothing
      Selection.Collapse direction:=wdCollapseEnd
Else
    ' do nothing, go on to next found word
End If

    Loop
End With
Set newDoc = Nothing
Set aDoc = Nothing
End Sub

Gerry

 

[alwayshouston]

Thanks fumei!
Your code is more efficient. But I still can't seem to find whatever text below the word "STATUS". Can you tell me how to compare the text "STATUS" to the find result rather than comparing the seletion length? I ran your above code and it skips wherever it finds the word status (either in a line itself or within the text in a paragaph).

Again Thank you for your prompt feedback!

 

[fumei]

Very strange. i ran the above on a different machine, and it didn't work. Then I ran it a couple more times...and it did. I compared the code and it is the same, I think. Will check it out some more.

Gerry

 

[TonyJollans]

Hi alwayshouston,

I haven't checked out your Excel code properly but I suspect all you need to do is to add ..

[blue][tt] Selection.Collapse wdCollapseEnd [/tt][/blue]

.. before redoing the find.

Hi Gerry,

The problem with your code is that you are using two different instances of the Find object - Activedocument.content.find and Selection.find.

As you don't set Selection.Find.Text, it is whatever it was last time you used it and if you have been doing some testing it may well be set to "Status" (but not on another m/c). I haven't tested it properly but I think all you need to do is to change ..

[blue]With ActiveDocument.Content.Find
    .ClearFormatting
    Do While .Execute(FindText:="Status", Forward:=True, _
            Format:=True) = True
            Selection.Find.Execute[/blue]

.. to ..

[blue]With Selection.Find
    .ClearFormatting
    Do While .Execute(FindText:="Status", Forward:=True, _
            Format:=True) = True[/blue]

Personally I would also set Format:=False but I don't think it will make a difference as you have Cleared it.

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

 

[alwayshouston]

Thanks Tony and Gerry!
I modified the code according to your recommendation, but it still does not find and copy the contents after the word "STATUS" to the spreadsheet. I ran the exact code by Gerry and it does not copy the content (from status to the end of the page). Below is my code. Please tell me what I am doing wrong. Thanks a bunch!

Sub CopyFromWord()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim i As Integer
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open("C:\Foldername\MyNewWordDoc.doc")


'
With Range("A1")
.Formula = "Word Document Contents:"
.Font.Bold = True
.Font.Size = 14
.Offset(1, 0).Select
End With
i = 3 ' startrow for the copied text from the Word document
wrdApp.Visible = True
wrdApp.Selection.HomeKey Unit:=wdStory
With wrdApp.Selection.Find
.ClearFormatting
Do While .Execute(FindText:="STATUS", Forward:=True, _
Format:=True) = True
wrdApp.Selection.Find.Execute
' above makes a selection of the word
' check to see if selection length equals
' line length, minus paragraph mark
If wrdApp.Selection.Range.End = _
(wrdDoc.Bookmarks("\line").Range.End - 1) And _
wrdApp.Selection.Range.Start = _
wrdDoc.Bookmarks("\line").Range.Start Then

lngStart = Selection.Range.Start
lngEnd = ActiveDocument.Bookmarks("\page").Range.End
Set r = wrdDoc.Range(Start:=lngStart, End:=lngEnd)
ActiveSheet.Range("A" & i).Formula = r.Text
i = i + 1
Set r = Nothing
wrdApp.Selection.Collapse direction:=wdCollapseEnd
Else
' do nothing, go on to next found word
End If

Loop
End With
wrdApp.Quit ' close the Word application
End Sub

 

[TonyJollans]

Hi alwayshouston,

A few minor tweaks are all that should be needed.

At the start of your loop you have ..

[blue]    Do While .Execute(FindText:="STATUS", Forward:=True, _
            Format:=True) = True
            wrdApp.Selection.Find.Execute[/blue]

Here you are doing two executions of the find - one in the loop control and one in the next statement; you need to remove the second one.

Next, you are not always addressing the Word application when you are trying to do things with the document, so ..

change .. [blue][tt]lngstart = Selection.Range.Start[/tt][/blue]
to .. [blue][tt]lngstart = [red]wrdApp.[/red]Selection.Range.Start[/tt][/blue]

.. and ..

change .. [blue][tt]lngend = ActiveDocument.Bookmarks("\page").Range.End[/tt][/blue]
to .. [blue][tt]lngend = [red]wrdDoc[/red].Bookmarks("\page").Range.End[/tt][/blue]

Finally, after you have copied the remains of your page to Excel, you then collapse the Selection, which is not what you have used to source your copy so you continue your word search from the end of the STATUS trigger rather than the end of the copied text. This may not matter in practice, depending on your data, but it would be better to replace ..
[blue][tt]wrdApp.Selection.Collapse direction:=wdCollapseEnd[/tt][/blue] with something like ..
[blue][tt]wrdDoc.Range(lngend, lngend).Select[/tt][/blue]

Put it all together and you get ..

[blue]Sub CopyFromWord()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim i As Integer
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open("C:\Documents and Settings\Tony\Desktop\rub.doc")


'
With Range("A1")
        .Formula = "Word Document Contents:"
        .Font.Bold = True
        .Font.Size = 14
        .Offset(1, 0).Select
    End With
    i = 3 [green]' startrow for the copied text from the Word document[/green]
wrdApp.Visible = True
wrdApp.Selection.HomeKey Unit:=wdStory
With wrdApp.Selection.Find
    .ClearFormatting
    Do While .Execute(FindText:="STATUS", Forward:=True, _
            Format:=True) = True
            [green]'wrdApp.Selection.Find.Execute [red]COMMENTED OUT[/red]
 ' above makes a selection of the word
 ' check to see if selection length equals
 ' line length,  minus paragraph mark[/green]
        If wrdApp.Selection.Range.End = _
            (wrdDoc.Bookmarks("\line").Range.End - 1) And _
            wrdApp.Selection.Range.Start = _
            wrdDoc.Bookmarks("\line").Range.Start Then
                    
                lngstart = [red]wrdApp.[/red]Selection.Range.Start
                lngend = [red]wrdDoc[/red].Bookmarks("\page").Range.End
                Set r = wrdDoc.Range(Start:=lngstart, End:=lngend)
                ActiveSheet.Range("A" & i).Formula = r.Text
                i = i + 1
                Set r = Nothing
                [red]wrdDoc.Range(lngend, lngend).Select[/red]
        Else
            [green]' do nothing, go on to next found word[/green]
        End If

    Loop
End With
wrdApp.Quit [green]' close the Word application[/green]
End Sub[/blue]

which, I hope, will do what you want.

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

 

[alwayshouston]

Thanks Tony!
It worked like a charm. I am new to WORD VBA. Do you recommend any website that can give me sample for smaller tasks in Word? I want to know how to select range, heiarchy of objects, etc...

Again, Thank you ALL very much for the help!
I would be out of job if you guys don't help me all the time.

 

[TonyJollans]

Hi alwayshouston,

Assuming you are familiar with VBA in Excel, it is the same language in Word - it's just the Word Object Model which is different. There is an overview of the object model in Word VBA Help (it's not the easiest to find - type object in the search box and then select Microsoft Word Objects). Also you can use the Object Browser and Macro Recorder to get pointers. Other than that there's a lot here if you search for it and look at the FAQs or a newer website -

http://www.vbaexpress.com

- is building a knowledge base which may well have some of what you are looking for.

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.