循环不移动到下一个文件

Question

我对以下代码有疑问。它似乎工作正常，但显然它无法移动到给定目录中的下一个文件；实际上，它会卡在第一个文件上，然后重新打开它，而无法转到下一个文件。任何帮助都非常感谢！

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

循环浏览我使用的文件的不同方法。

请注意，您需要在工具>参考中查看Microsoft Scripting Runtime

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

Answer 2

以下是遍历给定文件夹中所有 Excel 文件的基本方法：

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

这里是more on the Dir function。