Dir stuck in (nearly) infinite loop

[rsc2a]

Hi guys -

I have the following code that is supposed to swap out text for every file in a folder (as part of a larger bit of code), but when it is finished swapping the text, it starts back through the directory again replacing the text, and again, and again.....

Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False

    strFile = Dir$(strFolder & "*")
    Do Until strFile = ""
    
    ' Check if file is open
            
AfterClose:
 
    On Error Resume Next
        f = FreeFile()
        Open strFolder & strFile For Input Lock Read As #f
        Close #f

        If Err.Number <> 0 Then
            MsgBox ("Please close " & strFolder & strFile & " so the program can continue.")
            GoTo AfterClose
        End If
    
    On Error GoTo 0
    
' Replacing the text...

            Set WordDoc = WordApp.Documents.Open(strFolder & strFile)
                                        
            For Each myStoryRange In WordDoc.StoryRanges
                With myStoryRange.Find
                    .Text = badText
                    .Replacement.Text = goodText
                    .MatchCase = True
                    .MatchWholeWord = True
                    .Wrap = wdFindContinue
                    .Execute Replace:=wdReplaceAll
                End With
            Next myStoryRange
            
' Saves the file
            WordDoc.Save
            WordDoc.Close
        strFile = Dir$()
    Loop

After cycling through 20 or so times, it eventually jumps out. I've isolated it to this bit of code, but I'm stuck. Is there something obvious I'm missing here?

[Norie]

Try using FSO instead of Dir to get a list of the files in the directory, then loop through that list.