vba：永远循环

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. 在命中“”之后再次调用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