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

由于

的组合，您的代码会循环播放

在点击“”（返回无效的过程调用或参数）
您有* .ESY文件的奇数（> 1）
你有一个On Error Resume Next

vba：一个永远的循环

2 个答案: