Loop does not move to next file

Question

I have an issue with the below code. It seems to work fine but apparently it is not able to move to the next file in the directory given; it gets in fact stuck to the first file, and it reopens it, without being able to move on to the next one. Any help super appreciated!

Sub Cash_Line_Check(strTargetPath)

Dim i As Long
Dim sPath As String
Dim sFil As String
Dim FolderPath As String
Dim diaFolder As FileDialog
Dim CurrReturnColumn As Range, TotReturnColumn As Range, VarTotReturnColumn As Range, CashRow As Range
Dim oWbk As Workbook

'Open the file dialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    diaFolder.AllowMultiSelect = False
    diaFolder.InitialFileName = strTargetPath
    diaFolder.Show
    FolderPath = diaFolder.SelectedItems(1)

   'Without wanting to use the promp, use the below line:
   'FolderPath = strTargetFolder

 'Cycle through spreadsheets in selected folder

  sPath = FolderPath & "\" 'location of files

  sFil = Dir(sPath & "*.xls") 'change or add formats
  Do While sFil <> "" 'will start LOOP until all files in folder sPath have been looped through

   sFilTop20 = Dir(sPath & "TOP20" & "*.xls")
   If (Len(sFilTop20) > 0) Then GoTo loopline

    Set oWbk = Workbooks.Open(sPath & "\" & sFil) 'opens the file
    i = 1 'Selects the sheet to be analysed'

   'Perform Check and Record those funds adjusted
    With oWbk.Worksheets(i)

    Set CurrReturnColumn = .UsedRange.Find("Currency", , xlValues, xlWhole, xlByColumns)
    Set TotReturnColumn = .UsedRange.Find("Portfolio", , xlValues, xlWhole, xlByColumns) 'Looks by columns
    Set VarTotReturnColumn = .UsedRange.Find("Variation", , xlValues, xlWhole, xlByRows) 'Looks by rows
    Set CashRow = .UsedRange.Find("[Cash]", , xlValues, xlWhole, xlByRows)

    If .Cells(CashRow.Row, CurrReturnColumn.Column) > 0.1 Or .Cells(CashRow.Row, CurrReturnColumn.Column) < -0.1 Then
       .Cells(CashRow.Row, CurrReturnColumn.Column).Value = "-"
    End If

    If .Cells(CashRow.Row, TotReturnColumn.Column) > 0.1 Or .Cells(CashRow.Row, CurrReturnColumn.Column) < -0.1 Then
       .Cells(CashRow.Row, TotReturnColumn.Column).Value = "-"
    End If

    If .Cells(CashRow.Row, VarTotReturnColumn.Column) > 0.1 Or .Cells(CashRow.Row, CurrReturnColumn.Column) < -0.1 Then
       .Cells(CashRow.Row, VarTotReturnColumn.Column).Value = "-"
    End If

    End With

    oWbk.Close True

  sFil = Dir(sPath)

loopline:
 Loop

End Sub

Answer 1

Here is a basic way to loop through all Excel files within a given folder:

Sub LoopExcelFiles()
    Const xlsPath = "x:\ExcelTests"
    Dim fName As String
    fName = Dir(xlsPath & "\*.xl*") 'Find the first file
    
    Do While fName <> "" 'keep looping until file isn't found
    
        'do "whatever you gotta do" with each file here:
        Debug.Print "Folder:" & xlsPath, "Filename: " & fName
        
        fName = Dir() 'Find the next file (same criteria)
    Loop    
End Sub

Here is more on the Dir function .

Answer 2

Different approach to loop through files I use.

Please note you need to check Microsoft Scripting Runtime in Tools>References

Sub find_reports()

Dim fname As String

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the folder
strPath = ThisWorkbook.Path
fname = ThisWorkbook.Name
Set objFolder = objFSO.GetFolder(strPath)

'If the folder does not contain files, exit the sub
If objFolder.Files.Count = 0 Then
    MsgBox "No files in Folder", vbExclamation
    Exit Sub
End If

'Loop through each file in the folder
For Each objFile In objFolder.Files

    Debug.Print "Folder:" & strPath, "Filename: " & fname

Next objFile


End Sub