CODEWITHSUNDEEP
vbaexcel
Morpheus
Morpheus

Reputation: 3523

Looping through the same directory multiple times using a function

I am facing issues with VBA's looping through a list of files in a directory.

I need to loop through files which only have the word CITIES in the file name. But some times some files with the word CITIES might have a corresponding FINANCE file and hence I have to loop through the Folder again to find the finance file and extract information from it. I have written a funtion to get the file name if it exists and the biggest issue is the myFile = Dir which doesn't work as i hoped it would. I have the code which is here.

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

The issue is that when the myFIle1 = Dir in the function finishes executing, the original myFile = Dir also is at its end (at least I think it is)

Upvotes: 0

Views: 283

Answers (1)

braX
braX

Reputation: 11755

There is no way around this issue, that's just how the Dir Function works.

Instead, look into using a FileSystem object in the sub-function.

Alternatively, you can store all the filenames in the main function into an Array to loop thru instead of nesting your Dir functions like this:

  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

Then you have found all your CITIES in a 1 based Array to loop thru.

Upvotes: 1

Related Questions