vba: a forever loop

Question

Sub something(tecan)
On Error Resume Next

Dim arr As New Collection, a
Dim aFirstArray() As Variant
Dim i As Long


aFirstArray() = Array(Dir(tecan & "*.ESY", vbNormal))
aFirstArray(0) = Mid(aFirstArray(0), 1, 4)

Do While Dir <> ""
    ReDim Preserve aFirstArray(UBound(aFirstArray) + 1)
    aFirstArray(UBound(aFirstArray)) = Mid(Dir, 1, 4)
Loop

On Error Resume Next
For Each a In aFirstArray
    arr.Add a, a
Next

For i = 1 To arr.Count
    Cells(i, 1) = arr(i)
    'open_esy (tecan & arr(i) & "*")
Next

Erase aFirstArray
For i = 1 To arr.Count
  arr.Remove i
Next i

here is how i call this sub:

something (tecan1)
something (tecan2)

on the first call it works and does what it is supposed to

but on the second call it gets stuck in this loop:

Do While Dir <> ""
    ReDim Preserve aFirstArray(UBound(aFirstArray) + 1)
    aFirstArray(UBound(aFirstArray)) = Mid(Dir, 1, 4)
Loop

why does it get stuck in the loop?

Answer 1

I would avoid using the Dir Function, for what your trying to do. Everytime you call it with no parameters, it will return the next filename. Not sure why the loop is getting stuck though.

I would use the FileSystemObject Class, it has much greater control for you. Here is an example:

Function GetFiles(fileParam As String) As Collection
'create reference to Microsoft Scripting Runtime
'scrrun.dll

    Const dir               As String = "C:\"
    Dim fso                 As New FileSystemObject
    Dim myFolder            As Folder
    Dim loopFile            As File
    Dim returnCollection    As New Collection

    Set myFolder = fso.GetFolder(dir)

    For Each loopFile In myFolder.Files
        If loopFile.Name Like fileParam & "*.ESY" Then
            'add the loopfile path into the collection
            returnCollection.Add loopFile.Path
        End If
    Next loopFile

    Set GetFiles = returnCollection
End Function

Answer 2

Every time you use Dir, the iterator moves (this happens even if you have a watch on Dir).

Replace your loop with the below

f = Dir
Do While f <> ""
    ReDim Preserve aFirstArray(UBound(aFirstArray) + 1)
    aFirstArray(UBound(aFirstArray)) = Mid(f, 1, 4)
    f = Dir
Loop

Your code loops because of a combination of

1. Calling Dir once again after it hits "" (returns Invalid procedure call or argument)
2. You have an odd number (>1) of *.ESY files
3. You have an On Error Resume Next