VBA Loop in Word to find wildcard strings misses first occurrence

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 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))

Answer 2

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