Как найти строку в файле, закрыть файл и l oop для следующего файла в папке?

Question

Я хочу, чтобы l oop прошел через все файлы .xlsx в папке, ища строку.

Если найдено, запишите в файл имя файла, адрес ячейки, текст в ячейке и закройте файл и перейти к следующему файлу в папке.

Файл не отформатирован и имеет объединенные ячейки.

Приведенный ниже код работает частично. Проблема заключается в том, что если строка не найдена в файле, этот файл остается открытым, и нет перехода к следующему файлу.

Sub StringSearch()

    Dim lRow            As Long
    Dim oFile           As Object
    Dim oFiles          As Object
    Dim oFolder         As Object
    Dim rFound          As Range
    Dim rSearch         As Range
    Dim strFirstAddress As String
    Dim strSearch       As String
    Dim vPath           As Variant
    Dim wbk             As Workbook
    Dim wks             As Worksheet
    Dim wOut            As Worksheet

        Application.ScreenUpdating = False

        vPath = ThisWorkbook.Worksheets("Sheet1").Range("B3").Value
        strSearch = ThisWorkbook.Worksheets("Sheet1").Range("D3").Value

        With CreateObject("Shell.Application")
            Set oFolder = .Namespace(vPath)
                If oFolder Is Nothing Then
                    MsgBox "The folder """ & vPath & """ was Not Found.", vbExclamation
                    Exit Sub
                End If
            Set oFiles = oFolder.Items
            ' // Open only xls, xlsx, and xlsm workbooks
            oFiles.Filter 64, "*.xls;*.xlsx;*.xlsm"
        End With

        Set wOut = Worksheets.Add
        lRow = 1

        ' // Add row headers to the new worksheet.
        wOut.Range("A1:D1").Value = Array("Workbook", "Worksheet", "Cell", "Text in Cell")

        For Each oFile In oFiles
            Set wbk = Workbooks.Open _
                (Filename:=oFile.Path, _
                 UpdateLinks:=0, _
                 ReadOnly:=True, _
                 AddToMRU:=False)

            For Each wks In wbk.Worksheets
                Set rSearch = wks.UsedRange
                Set rFound = rSearch.Find(strSearch)
                If rFound Is Nothing Then Exit Sub

                strFirstAddress = rFound.Address

                Do
                    lRow = lRow + 1
                    wOut.Cells(lRow, "A").Resize(1, 4).Value = Array(wbk.Name, wks.Name, rFound.Address, Split(rFound.Value, "P")(0))

                    Set rFound = wks.Cells.FindNext(rFound)
                    If rFound Is Nothing Then Exit Do
                    If rFound.Address = strFirstAddress Then Exit Do
                Loop
            Next wks

            wOut.Columns("A:D").EntireColumn.AutoFit
            wbk.Close SaveChanges:=False
        Next oFile

        MsgBox "Done"

        Application.ScreenUpdating = True

End Sub