使用 Excel VBA Dir() 函数循环并打开文件目录提前退出

Question

Posting this here in case someone is having similar trouble. Not really looking for an answer, just posting in case someone is in need of a solution to a similar problem. If someone has some experience as to exactly what is going on or a way to further mitigate the problem I will check mark their answer.

I needed to loop through a directory of .csv files, retrieve a piece of information from each one and compile in a new .xlsx file. My solution was based on this thread:

VBA code to loop through files in a folder

The trouble I WAS having was that the Dir() function was bailing well before looping through all the files (I had 500 of them...it was stopping at random places, sometimes 18th, sometimes 90th, sometimes 97th). It took me a while to figure out what was going on. Apparently, while this function was executing, other things I was doing (I assume it was a Word document I was writing) was telling the macro to stop with no error codes. It was just exiting out of the loop (I was using a while -> wend loop) leaving the last document the function visited opened and not executing the close statement. I confirmed this by shutting everything down and running the macro without anything else open and it finished executing.

So if you're having trouble with the Dir() function stopping execution before checking every file in a directory, close other microsoft applications. They may be interfering.

Answer 1

To avoid the Dir bug, collect the files first and then process them. Do not do any office related stuff between the calls to Dir .

Option Explicit

' Get the files specified
Function GetFiles(MyFolder As String) As Variant
    Dim MyFile As Variant, Files As Variant
    Dim NumFiles As Long, Idx As Long
    
    ' Collect files only and ignore folders
    MyFile = Dir(MyFolder)
    NumFiles = 0
    Do While MyFile <> ""
        NumFiles = NumFiles + 1
        If NumFiles = 1 Then
            ReDim Files(1 To 1)
        Else
            ReDim Preserve Files(1 To NumFiles)
        End If
        Files(NumFiles) = MyFile
        MyFile = Dir()
    Loop
    GetFiles = Files
End Function

Sub ProcessFiles(MyFolder As String)
    Dim MyFile As Variant
    Dim Files As Variant
    Dim Idx As Long
    
    Files = GetFiles(MyFolder)
    If Not IsEmpty(Files) Then
        For Idx = LBound(Files) To UBound(Files)
            MyFile = Files(Idx)
            ' Process the file here
            Debug.Print MyFile
        Next Idx
    Else
        Debug.Print "No files found for Dir(""" & MyFolder & """)"
    End If
End Sub

Sub TestProcessFiles()
    ProcessFiles "C:\windows\*.*"
End Sub