УВА: а навсегда петля

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, итератор перемещается (это происходит, даже если у вас есть часы на Dir).

Замените петлю ниже

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

Ваш код петли из комбинации

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

Answer 2

Я бы не использовал функцию 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