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

这是循环浏览给定文件夹中所有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。

Answer 2

用于遍历我使用的文件的不同方法。

请注意，您需要在工具>参考文献中检查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

循环不会移到下一个文件

2 个答案: