VBA: вечная петля

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

вот как я называю эту подпрограмму:

something (tecan1)
something (tecan2)

при первом вызове он работает и делает то, что должен

, но при втором вызове застреваетв этом цикле:

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

почему он застревает в цикле?

Answer 1

Я бы не стал использовать функцию Dir для того, что вы пытаетесь сделать.Каждый раз, когда вы вызываете его без параметров, он возвращает следующее имя файла.Не уверен, почему цикл застревает.

Я бы использовал класс FileSystemObject, он имеет гораздо больший контроль для вас.Вот пример:

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

Каждый раз, когда вы используете Dir, итератор перемещается (это происходит, даже если у вас есть часы на Dir).

Замените ваш цикл следующим:

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

Ваш код зацикливается из-за комбинации

1. Повторный вызов Dir после нажатия "" (возвращает Invalidвызов процедуры или аргумент)
2. У вас есть нечетное число (> 1) из * .ESY файлов
3. У вас при возобновлении при ошибке Далее