Question

我遇到的问题是VBA循环浏览目录中的文件列表。

我需要遍历文件名中只有CITIES一词的文件。但有时一些带有CITIES一词的文件可能有相应的FINANCE文件，因此我必须再次遍历文件夹以找到财务文件并从中提取信息。我写了一个函数来获取文件名（如果它存在），最大的问题是myFile = Dir，它不会像我希望的那样工作。我有代码在这里。

Sub getTheExecSummary()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog


'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False

myPath = "C:\Users\MORPHEUS\Documents\Projects\"

myExtension = "*CITIES*.xls"

myFile = Dir(myPath & myExtension)

Debug.Print myFile

Do While Len(myFile) > 0
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(Filename:=myPath & myFile)
    Dim prntStr As String

    prntStr = wb.Worksheets("Sheet1").Cells(1, 1) & " (n= " _
        & wb.Worksheets("Sheet2").Cells(12, 3) & ")"

    Dim LookUpStr As String
    LookUpStr = wb.Name

    replaceStr = Left(LookUpStr, 10)

    LookUpStr = Replace(LookUpStr, replaceStr, "")


    Dim DoesTheFIleexist As String
    DoesTheFIleexist = fileLoation(myPath, LookUpStr)

    If (Len(DoesTheFIleexist) > 0) Then
        Debug.Print (DoesTheFIleexist)
    End If

    Workbooks("ExecutiveSummary.xlsm").Sheets("Sheet1").Range("A1").Value = myFile

    wb.Close SaveChanges:=False

    'Get next file name
    Debug.Print myFile
    myFile = Dir
Loop

End Sub



Function fileLoation(filePath As String, LookUpStr As String) As String
    Dim financeStr As String
    Dim myFile1 As String
    financeStr = "*FIN*.xls"
    myFile1 = Dir(filePath & financeStr)

    Do While Len(myFile1) > 0
         Debug.Print ("")
         Debug.Print (myFile1)
'        If InStr(myFile1, LookUpStr) > 0 Then
'            fileLoation = myFile1
'        Else
'            fileLoation = ""
'        End If
        myFile1 = Dir
    Loop
End Function

问题在于，当函数中的myFIle1 = Dir完成执行时，原始的myFile = Dir也在它的末尾（至少我认为是）

Answer 1

无法绕过这个问题，这就是Dir功能如何运作。

相反，请考虑在子函数中使用FileSystem对象。

或者，您可以将main函数中的所有文件名存储到Array以循环，而不是嵌套Dir函数，如下所示：

  Dim sFiles() as String
  Dim sFilename as String
  ReDim sFiles(0)
  sFilename = Dir(myPath & "*CITIES*.xls")
  Do Until sFilename = ""
    ReDim Preserve sFiles(UBound(sFiles) + 1)
    sFiles(UBound(sFiles)) = sFilename
    sFilename = Dir()
  Loop

然后，您已经找到了基于1 Array的所有CITIES来循环播放。

使用函数多次循环同一目录

1 个答案: