遍历文件夹生成统计excel

aliha

遍历文件夹生成excel统计表

1、功能

可以遍历制定文件夹的所有文件，生成excel统计表，并添加超链接。

2、演示截图

软件执行截图

生成文件

3、链接

蓝奏云：下载:https://wwm.lanzouq.com/iyWbd021duhe 密码:25w2

4、说明

1、新人小白，工作总需要统计很多文件，层层嵌套的文件夹看的我头晕。软件写的比较拉，源码就不放了。
2、软件是用python写的，用到的库是openpyxl。打包使用的是Nuitka。
3、关键代码：
获取文件信息:

def getFileInfo(fpath:str):
    statinfo = os.stat(fpath)
    file_size = statinfo.st_size # 文件大小（字节）
    create_time = tstampToDate(statinfo.st_ctime) #创建时间
    modify_time = tstampToDate(statinfo.st_mtime)# 上次修改时间
    return file_size,create_time,modify_time

遍历获得文件路径：

fls = []

def showFiles(dir_path:str):
    dir_or_files = os.listdir(dir_path)
    for item in dir_or_files:
        p = os.path.join(dir_path,item)
        if os.path.isdir(p):
            fls.append(p)
            showFiles(p)
        elif os.path.isfile(p):
            fp = os.path.join(dir_path,item)
            fls.append(fp)

2022-3-28更新
1、增加输出路径

更新

效果：

更新效果

下载地址（包含源代码）：https://wwm.lanzouq.com/b01dbuuqh 密码:bbqv


推荐#25楼的老哥写的VBA，很棒

3131210

来一个VBA版本，直接在excel里面跑的，效果图
一时手痒写的，有任何问题，后续都可能不会维护或修改



2022年4月12日 12点10分 更新
修复遍历根目录报错的问题

[Asm] 纯文本查看 复制代码

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

3131210

pojie1655 发表于 2022-7-7 22:50
不要第二行的文件夹名称，只要在C列显示全部文件全路径名称如何修改代码呢？

[Asm] 纯文本查看 复制代码

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

[Asm] 纯文本查看 复制代码

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

一个是不显示根目录文件夹
一个是不显示所有文件夹
不知道你要什么

lizhipei78

vba  代码比你这个简单

sksun1983

不要路径，只要文件名可以吗

aliha

sksun1983 发表于 2022-3-26 10:34
不要路径，只要文件名可以吗

可以的，我正在改，刚想明白怎么搞，稍等今天我更新一下

aliha

lizhipei78 发表于 2022-3-26 10:02
vba  代码比你这个简单

看了好久VBA，用excel做了好久没搞出来，其实直接在excel里边写宏更方便

zg3000

收藏了，使用了效果不错是，就是提供路径比较麻烦些，高度关注

lrr0515

文件打不开，不知道什么情况

victte

多谢大佬的生成工具

tp206555

优秀楼主

yuechaomax

python处理这类问题得心应手