VBA中FileSystemObject文件排序异常，求保持原始序列方案

问题核心 #

FileSystemObject默认按字符串字典序返回文件，所以会出现1、10、11…20、2、21…的错误排序。要实现自然排序，关键是让程序识别文件名中的数字数值，而非单纯按字符串字符比较。

现有代码优化 #

你的代码思路正确：提取-前缀的数字段，分离数字开头和非数字开头的文件后排序合并。但原冒泡排序效率较低，可替换为更高效的插入排序，同时减少Collection的反复增删操作：

优化后的排序子过程 #

替换原bubbleSort：

Sub InsertionSort(col As Collection)
    Dim i As Long, j As Long
    Dim temp As Variant
    
    For i = 2 To col.Count
        temp = col(i)
        j = i - 1
        ' 按数字段数值大小比较
        Do While j >= 1 And col(j)(0) > temp(0)
            col(j + 1) = col(j)
            j = j - 1
        Loop
        col(j + 1) = temp
    Next i
End Sub

优化说明 #

• 插入排序避免了冒泡排序中频繁的CollectionRemove/Add操作，小数据量下效率提升明显
• 完全兼容你原有的数字/非数字文件分离逻辑

更通用的自然排序方案（推荐） #

如果文件名规则可能变化（比如数字不在-前、包含多段数字），可以调用Windows系统API的StrCmpLogicalW函数，实现和资源管理器完全一致的自然排序：

完整实现代码 #

Option Explicit

' 兼容64位Office的API声明，32位Office可去掉PtrSafe，将LongPtr改为Long
Private Declare PtrSafe Function StrCmpLogicalW Lib "shlwapi.dll" (ByVal psz1 As LongPtr, ByVal psz2 As LongPtr) As Integer

Sub NaturalSortFiles()
    Dim FolderPath As String
    Dim fso As Object
    Dim folder As Object
    Dim fileItem As Object
    Dim tempDoc As Document
    Dim fileArr() As String
    Dim i As Long, j As Long
    Dim tempStr As String
    
    Set tempDoc = ActiveDocument
    FolderPath = tempDoc.Path & Application.PathSeparator
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 遍历目标路径下的子文件夹
    For Each folder In fso.GetFolder(FolderPath).Subfolders
        ' 将符合条件的文件名存入数组
        ReDim fileArr(1 To folder.Files.Count)
        i = 1
        For Each fileItem In folder.Files
            ' 仅处理含"-"的文件，和原逻辑一致
            If InStr(fileItem.Name, "-") > 0 Then
                fileArr(i) = fileItem.Name
                i = i + 1
            End If
        Next
        ' 调整数组大小，移除空元素
        If i > 1 Then
            ReDim Preserve fileArr(1 To i - 1)
            
            ' 调用API执行自然排序
            For i = LBound(fileArr) To UBound(fileArr) - 1
                For j = i + 1 To UBound(fileArr)
                    ' 返回值>0表示前者排序靠后，需要交换
                    If StrCmpLogicalW(StrPtr(fileArr(i)), StrPtr(fileArr(j))) > 0 Then
                        tempStr = fileArr(i)
                        fileArr(i) = fileArr(j)
                        fileArr(j) = tempStr
                    End If
                Next j
            Next i
            
            ' 输出排序结果，此处替换为你的业务处理逻辑
            For i = LBound(fileArr) To UBound(fileArr)
                Debug.Print fileArr(i)
            Next i
        End If
    Next folder
End Sub

方案优势 #

• 和Windows资源管理器排序逻辑完全一致，支持任意含数字的文件名（如file1.txt、12-xyz.txt等）
• 无需手动提取数字段，适配更复杂的文件名规则
• API调用效率高，适合处理大量文件的场景

注意事项 #

• 若要处理所有文件（无论是否含-），直接删除If InStr(fileItem.Name, "-") > 0 Then判断即可
• 32位Office环境下，需修改API声明：去掉PtrSafe，将LongPtr改为Long

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