遍历文件夹生成统计excel

可以遍历制定文件夹的所有文件，生成excel统计表，并添加超链接。VBA版本，直接在excel里面使用。171517bghzwxw6g3hh9yg1.png

VBA脚本

Public iFileSys As Object
Sub 遍历文件夹()
    Cells.Delete                                               '清除表格所有数据
    Columns("B:B").NumberFormatLocal = "@"
    Columns("F:G").NumberFormatLocal = "yyyy-mm-dd hh:mm:ss"
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = -1 Then
            iPath = .SelectedItems(1)
        End If
    End With
     
    If iPath = "False" Or Len(iPath) = 0 Then Exit Sub         '所选文件夹为空，结束脚本
     
    ReDim arr(1 To 7, 1 To 1)
    arr(1, 1) = "层级"
    arr(2, 1) = "文件名"
    arr(3, 1) = "完整路径（包含超链接）"
    arr(4, 1) = "类型"
    arr(5, 1) = "文件大小（KB）"
    arr(6, 1) = "创建时间"
    arr(7, 1) = "修改时间"
    Set iFileSys = CreateObject("Scripting.FileSystemObject")
    Call GetFolderFile(iPath, arr, 0)
    arr = TransposeArray(arr)
    ActiveSheet.Range("A1").Resize(UBound(arr), 7) = arr
     
    For i = 2 To UBound(arr)
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=Cells(i, 3)
    Next
     
    ActiveSheet.Rows.AutoFit
    ActiveSheet.Columns.AutoFit
     
    MsgBox "Done."
End Sub
Private Sub GetFolderFile(ByVal nPath As String, arr As Variant, TreeNum As Long)
    On Error Resume Next
    Set iFolder = iFileSys.GetFolder(nPath)
    Set sFolder = iFolder.SubFolders
    Set iFile = iFolder.Files
     
    Call AddList(iFolder, arr, TreeNum)
     
    For Each gFile In iFile
        Call AddList(gFile, arr, TreeNum)
    Next
     
    '递归遍历所有子文件夹
    For Each nFolder In sFolder
        Call GetFolderFile(nFolder.Path, arr, TreeNum + 1)
    Next
    On Error GoTo 0
End Sub
Private Sub AddList(ByVal obj As Object, arr As Variant, TreeNum As Long)
    On Error Resume Next
    ub = UBound(arr, 2) + 1
    ReDim Preserve arr(1 To 7, 1 To ub)
    arr(1, ub) = TreeNum                                       '层级
    arr(2, ub) = CStr(IIf(Len(obj.Name) = 0, "\", obj.Name))                            '文件名
    arr(3, ub) = obj.Path                                      '文件路径
    arr(4, ub) = obj.Type                                      '文件类型
    arr(5, ub) = Format(obj.Size / 1024, "#,##0.00")           '文件大小(KB)
    arr(6, ub) = Format(obj.DateCreated, "yyyy-mm-dd hh:mm:ss") '创建时间
    arr(7, ub) = Format(obj.DateLastModified, "yyyy-mm-dd hh:mm:ss")    '修改时间
    On Error GoTo 0
End Sub
Function TransposeArray(arrA) As Variant
    Dim aRes()
    If IsArray(arrA) Then
        ReDim aRes(LBound(arrA, 2) To UBound(arrA, 2), LBound(arrA, 1) To UBound(arrA, 1))
        For i = LBound(arrA, 1) To UBound(arrA, 1)
            For j = LBound(arrA, 2) To UBound(arrA, 2)
                aRes(j, i) = arrA(i, j)
            Next
        Next
        TransposeArray = aRes
    End If
End Function

不显示根目录文件夹

Private Sub GetFolderFile(ByVal nPath As String, arr As Variant, TreeNum As Long)
    On Error Resume Next
    Set iFolder = iFileSys.GetFolder(nPath)
    Set sFolder = iFolder.SubFolders
    Set iFile = iFolder.Files
     
    If TreeNum <> 0 Then
        Call AddList(iFolder, arr, TreeNum)
    End If
     
    For Each gFile In iFile
        Call AddList(gFile, arr, TreeNum)
    Next
      
    '递归遍历所有子文件夹
    For Each nFolder In sFolder
        Call GetFolderFile(nFolder.Path, arr, TreeNum + 1)
    Next
    On Error GoTo 0
End Sub

不显示所有文件夹

Private Sub GetFolderFile(ByVal nPath As String, arr As Variant, TreeNum As Long)
    On Error Resume Next
    Set iFolder = iFileSys.GetFolder(nPath)
    Set sFolder = iFolder.SubFolders
    Set iFile = iFolder.Files
     
    'Call AddList(iFolder, arr, TreeNum)
     
    For Each gFile In iFile
        Call AddList(gFile, arr, TreeNum)
    Next
      
    '递归遍历所有子文件夹
    For Each nFolder In sFolder
        Call GetFolderFile(nFolder.Path, arr, TreeNum + 1)
    Next
    On Error GoTo 0
End Sub

脚本来自吾爱的3131210！