VBA Loop in Word to find wildcard strings misses first occurrence - vba

Question

I have some VBA for Microsoft Word that is supposed to find some five digit numbers using wildcards in multiple files and then the sticks them and the path/file into an excel file. Unfortunately, it ALWAYS misses the first occurrence of the wildcard string. I cannot determine why!
I've tried reordering things to make sure that it's not being missed, however, I am unable to get it working properly. When I run the wildcard search myself by hand, it finds the first occurence. It doesn't do it in VBA, however.
Public Sub TestFindNumbers()
Dim i As Long
i = 2 ' Row in Excel to start
Dim ObjExcel As Object, ObjWorkBook As Object, ObjWorksheet As Object
Set ObjExcel = CreateObject("EXCEL.APPLICATION")
Set ObjWorkBook = ObjExcel.Workbooks.Add
Set ObjWorksheet = ObjWorkBook.Worksheets("Sheet1")
Set dlgFile = Application.FileDialog(msoFileDialogFilePicker)
With dlgFile
dlgFile.AllowMultiSelect = True
If .Show = -1 Then
For nDocx = 1 To dlgFile.SelectedItems.Count
Documents.Open dlgFile.SelectedItems(nDocx)
Set objDocx = ActiveDocument
With objDocx.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[0-9]{5}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
.Collapse wdCollapseEnd
.Find.Execute
If .Text <> "" Then
ObjWorksheet.Cells(i, 1) = Left(.Text, 8)
ObjWorksheet.Cells(i, 2) = dlgFile.SelectedItems(nDocx)
Else
i = i - 1
End If
i = i + 1
Loop
End With
objDocx.Close SaveChanges:=wdDoNotSaveChanges
Next nDocx
Else
MsgBox ("You need to select documents first!")
Exit Sub
End If
End With
ObjWorksheet.Cells(1, 1) = "Number"
ObjWorksheet.Cells(1, 2) = "Path & Filename"
ObjExcel.Visible = 1
Set objDocx = Nothing
Set ObjExcel = Nothing
Set ObjWorkBook = Nothing
Set ObjWorksheet = Nothing
End Sub
I created a single test file with the following:
1234 Shouldn’t be selected
12345 Select this one. First occurrence.
98765 Another good one
568 Nope
This one is 55555 in the middle
End
When I run my VBA code, I'm getting 98765 and 55555 as hits. Unfortunately, 12345 isn't being found.

Answer 1

The reason the code in the question is not finding the search terms as expected:
The Collapse, then Find.Execute methods are in the loop before the first result is picked up. Since .Execute is also in the With block preceding the loop, Find runs twice, thus masking the first occurrence of the search term.
In addition:
1) Preferably, a specific Range should be used for the search, rather than the entire document (objDocx.Range). This is due to the "collapsing" - it works more reliably when there's a specific Range object.
2) Do not use Find.Wrap = wdFindContinue as suggested in comments. wdFindStop (as in the code in the question) is correct when using Find in a loop. wdFindContinue will often lead to an "infinite loop" as Word will start at the beginning of the document again, and again...
3) It's possible (better) to set a Document object when a file is being opened (or created), rather than relying on ActiveDocument in a second step:
Set objDocx = Documents.Open dlgFile.SelectedItems(nDocx)
Here's the part of the code that has to do with the Find - I've left out the Excel parts to make it easier to read
Dim objDocx As Word.Document
Dim rngFind As Word.Range
Set objDocx = Documents.Open dlgFile.SelectedItems(nDocx)
Set rngFind = objDocx.content
With rngFind
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[0-9]{5}"
.Replacement.Text = ""
.Forward = True
.wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
If .Text <> "" Then
ObjWorksheet.Cells(i, 1) = Left(.Text, 8)
ObjWorksheet.Cells(i, 2) = dlgFile.SelectedItems(nDocx)
Else
i = i - 1
End If
i = i + 1
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With

Answer 2

The problem is with your Do While loop. Change it to:
Do While .Find.Found
ObjWorksheet.Cells(i, 1) = Left(.Text, 8)
ObjWorksheet.Cells(i, 2) = objDocx.Name
i = i + 1
.Collapse wdCollapseEnd
.Find.Execute
Loop
Also, instead of:
Documents.Open dlgFile.SelectedItems(nDocx)
Set objDocx = ActiveDocument
use:
Set objDocx = Documents.Open(dlgFile.SelectedItems(nDocx))