统计文件夹文件时Dir函数的异常行为问题排查

问题背景 #

用户编写了如下VBA函数用于统计指定路径下特定类型的文件数量：

Function CountFilesInFolder(sPath As String, Optional sFileType As String) As Long

    Dim vFile As Variant
    Dim lFileCount As Long
    
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\" 
    vFile = Dir(sPath & sFileType)
    While (vFile <> "")
        lFileCount = lFileCount + 1
        vFile = Dir
    Wend
    
    CountFilesInFolder = lFileCount
End Function

测试场景：目标文件夹包含2个.xls文件和3个.xlsx文件。调用Debug.Print CountFilesInFolder("C:\test\", "*.xls")时，预期返回2，但实际返回5（包含所有xlsx文件）；调用Debug.Print CountFilesInFolder("C:\test\", "*.xlsx")则正常返回3。

问题原因 #

这是VBA中Dir函数的历史兼容特性导致的：

• 早期DOS/Windows采用8.3短文件名规则，.xlsx文件的短文件名会被截断为类似XL~1.XLS的格式（后缀保留为.XLS）。
• 默认情况下，Dir函数会同时匹配长文件名和短文件名，因此*.xls会匹配真正的.xls文件，以及.xlsx文件对应的短文件名。
• 而*.xlsx没有对应的短文件名兼容规则（因为.xlsx是Office 2007之后才出现的格式，此时短文件名机制已不再强制），所以只会匹配真正的.xlsx文件。

修复方案 #

方案1：修改Dir函数调用，强制匹配长文件名 #

在调用Dir时添加vbLongFileNames参数，强制只识别长文件名，避免短文件名的干扰：

Function CountFilesInFolder(sPath As String, Optional sFileType As String) As Long
    Dim vFile As Variant
    Dim lFileCount As Long
    
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\" 
    ' 添加vbLongFileNames参数，仅匹配长文件名
    vFile = Dir(sPath & sFileType, vbNormal + vbLongFileNames)
    While (vFile <> "")
        lFileCount = lFileCount + 1
        vFile = Dir() ' 后续Dir调用无需重复传参
    Wend
    
    CountFilesInFolder = lFileCount
End Function

方案2：使用FileSystemObject（更可靠） #

FileSystemObject（FSO）的文件匹配逻辑更直观，不会受短文件名兼容问题影响，适合需要精确统计的场景：

Function CountFilesInFolder_FSO(sPath As String, Optional sFileType As String = "*.*") As Long
    Dim fso As Object
    Dim targetFolder As Object
    Dim fileCollection As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' 先判断文件夹是否存在
    If Not fso.FolderExists(sPath) Then
        CountFilesInFolder_FSO = 0
        Exit Function
    End If
    
    Set targetFolder = fso.GetFolder(sPath)
    Set fileCollection = targetFolder.Files
    
    Dim singleFile As Object
    For Each singleFile In fileCollection
        ' 统一转为小写，避免大小写敏感问题
        If LCase(singleFile.Name) Like LCase(sFileType) Then
            CountFilesInFolder_FSO = CountFilesInFolder_FSO + 1
        End If
    Next singleFile
    
    ' 释放对象
    Set fso = Nothing
    Set targetFolder = Nothing
    Set fileCollection = Nothing
End Function

内容的提问来源于stack exchange，提问作者Michael Wycisk