For my work I have to find all the instances of a style in 40 word documents (.doc). Once I get the text, I want to write it in a cell in my excel sheet (.xls).
With the code I wrote I can get the first instance of that style but I cannot get the next one, it goes into an infinite loop and I don't now why (there are about 10 occurrences on each file).
Could you tell me where I am wrong?
I want to go from that: Before running the macro to that: After running the macro
Here is my code:
'==================================================================
' Declarations
'==================================================================
Dim ObjWord As Object ' Word application object
'==================================================================
' Macro
'==================================================================
Public Sub Macro()
Dim row As Integer
row = 9 'first available row
Set ObjWord = CreateObject("word.application")
Worksheets("Sheet 2").Activate
While (Cells(row, 2).Value <> "End of file list")
Set file = ObjWord.documents.Open(ThisWorkbook.path & ".\" & Cells(row, 1).Hyperlinks(1).Address)
Set currentRange = file.Range
currentRange.Find.ClearFormatting
currentRange.Find.Forward = True
currentRange.Find.Text = ""
currentRange.Find.Style = "MyStyle"
bFind = currentRange.Find.Execute
Do While bFind 'here is the endless loop
row = row + 1
StyleValue= currentRange.Text 'I get stuck with the first value :-(
Rows(row).EntireRow.Insert
Cells(row, 2).Value = StyleValue
bFind = currentRange.Find.Execute
Loop
file.Close
row = row + 1 ' next File
Wend
ObjWord.Quit
End Sub
I think it needs to be this:
Do While currentRange.Find.Found
currentRange.Find.Execute
Loop
I had to make a number of changes to get it to work for me, mostly because I have Option Explicit
on and declare all variables.
However while going through it something that may be the issue if it is looping on the first find, is that you have to move the selection past the find to find the next one.
Do While bFind 'here is the endless loop
row = row + 1
StyleValue= currentRange.Text 'I get stuck with the first value :-(
Rows(row).EntireRow.Insert
Cells(row, 2).Value = StyleValue
currentRange.SetRange currentRange.End, currentRange.End
bFind = currentRange.Find.Execute
Loop
If that doesn't work I can pop up a full replacement later
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.