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時，迭代器都會移動（即使您在Dir上有手錶也會發生這種情況）。

與下面

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

你的代碼循環，因爲

1. 再次擊中「」後調用迪爾的組合替換你的循環（返回無效的過程調用或參數）
2. 您有* .ESY文件的奇數（> 1）
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