利用EXCEL扫描同文件夹内所有文件夹

想利用excel汇总一下同文件夹内的所有文件夹，供搜索和整理，让deepseek写了以下代码。汇总成表，并提供超链接，这样管理起来更加清晰一些。

Sub ScanAllFoldersRecursive()
    Dim objFSO As Object
    Dim ws As Worksheet
    Dim i As Long
    Dim basePath As String
    Dim folderCount As Long
    Dim skippedCount As Long
    
    ' 设置工作表
    Set ws = ThisWorkbook.Sheets(1)
    ws.Cells.Clear
    ws.Range("A1:E1").Value = Array("序号", "文件夹名称", "完整路径", "层级", "超链接")
    ws.Range("A1:E1").Font.Bold = True
    
    ' 获取当前工作簿所在路径
    basePath = ThisWorkbook.Path
    If basePath = "" Then
        MsgBox "请先保存工作簿！", vbExclamation
        Exit Sub
    End If
    
    ' 创建文件系统对象
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    i = 2 ' 从第二行开始
    folderCount = 0
    skippedCount = 0
    
    ' 开始递归扫描
    Call ScanFolder(objFSO.GetFolder(basePath), ws, i, folderCount, skippedCount, 0, basePath)
    
    ' 自动调整列宽
    ws.Columns("A:E").AutoFit
    
    ' 添加边框
    If i > 2 Then
        With ws.Range("A1:E" & i - 1).Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    End If
    
    ' 添加筛选功能
    ws.Range("A1:E1").AutoFilter
    
    ' 美化表格
    With ws
        .Rows(1).RowHeight = 25
        .Range("A1:E1").Interior.Color = RGB(200, 200, 200)
        .Range("A1:E1").HorizontalAlignment = xlCenter
    End With
    
    ' 显示结果消息
    Dim msg As String
    msg = "扫描完成！" & vbCrLf & _
          "找到文件夹总数: " & folderCount & " 个" & vbCrLf & _
          "跳过文件夹: " & skippedCount & " 个"
    
    MsgBox msg, vbInformation, "扫描结果"
    
    ' 清理对象
    Set objFSO = Nothing
End Sub

' 递归扫描文件夹的核心函数
Sub ScanFolder(parentFolder As Object, ws As Worksheet, ByRef rowIndex As Long, _
               ByRef folderCount As Long, ByRef skippedCount As Long, _
               level As Integer, basePath As String)
    Dim subFolder As Object
    Dim subSubFolder As Object
    
    On Error Resume Next
    
    ' 首先处理当前父文件夹的直接子文件夹
    For Each subFolder In parentFolder.SubFolders
        ' 跳过系统文件夹和临时文件夹
        If Not IsSystemOrTempFolder(subFolder.Name) Then
            ' 检查文件夹是否可访问
            Dim testAttr As Integer
            testAttr = subFolder.Attributes
            If Err.Number = 0 Then
                ' 添加到工作表
                ws.Cells(rowIndex, 1).Value = rowIndex - 1 ' 序号
                ws.Cells(rowIndex, 2).Value = subFolder.Name
                ws.Cells(rowIndex, 3).Value = subFolder.Path
                ws.Cells(rowIndex, 4).Value = level ' 层级
                
                ' 创建超链接
                ws.Hyperlinks.Add Anchor:=ws.Cells(rowIndex, 5), _
                                 Address:=subFolder.Path, _
                                 TextToDisplay:="打开文件夹"
                
                rowIndex = rowIndex + 1
                folderCount = folderCount + 1
                
                ' 递归扫描子文件夹的子文件夹（增加层级）
                If level < 20 Then ' 防止无限递归，设置最大层级为20
                    Call ScanFolder(subFolder, ws, rowIndex, folderCount, skippedCount, level + 1, basePath)
                End If
            Else
                ' 清除错误并跳过
                Err.Clear
                skippedCount = skippedCount + 1
            End If
        Else
            skippedCount = skippedCount + 1
        End If
    Next subFolder
    
    On Error GoTo 0
End Sub

' 辅助函数：检查是否为系统或临时文件夹
Function IsSystemOrTempFolder(folderName As String) As Boolean
    ' 跳过以特定前缀开头的文件夹
    Dim excludePrefixes As Variant
    excludePrefixes = Array("~$", ".", "$", "System Volume Information", "RECYCLE", "Windows", "Config.Msi", "MSOCache")
    
    Dim prefix As Variant
    For Each prefix In excludePrefixes
        If Left(folderName, Len(prefix)) = prefix Then
            IsSystemOrTempFolder = True
            Exit Function
        End If
    Next prefix
    
    ' 跳过隐藏文件夹（名称包含特定字符）
    If InStr(folderName, "~") > 0 Or InStr(folderName, "$") > 0 Then
        IsSystemOrTempFolder = True
        Exit Function
    End If
    
    IsSystemOrTempFolder = False
End Function

' 创建扫描按钮
Sub AddScanButton()
    Dim btn As Button
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Sheets(1)
    
    ' 删除现有按钮
    On Error Resume Next
    ws.Buttons.Delete
    On Error GoTo 0
    
    ' 添加新按钮
    Set btn = ws.Buttons.Add(10, 10, 150, 30)
    With btn
        .Caption = "扫描所有子文件夹"
        .OnAction = "ScanAllFoldersRecursive"
        .Name = "ScanAllButton"
    End With
    
    MsgBox "扫描按钮已添加！点击即可扫描所有层级的子文件夹。"
End Sub

' 初始化并开始扫描
Sub InitializeAndScan()
    AddScanButton
    ScanAllFoldersRecursive
End Sub

' 快速扫描（不包含按钮添加）
Sub QuickScan()
    ScanAllFoldersRecursive
End Sub