批量获取文件夹下所有文件信息(修改时间)

批量获取文件夹下所有文件信息(修改时间)

十一月 26, 2023 阅读量

批量获取文件夹下所有文件信息(修改时间)

依旧是给朋友写的小工具,在原来写的几个小工具上改的,写成Python版本后,又写了VBA版(个人还是喜欢VBA)和VBS版,其他版本暂时不想搞了,意义不大

思路

  1. 打开一个文件对话框,用于选择文件夹
  2. 便利文件夹下所有文件,包含子文件夹下文件,但不包含子文件夹本身
  3. 获取文件信息,并写入Excel文件中

这里只获取了文件创建时间,修改时间。其他文件属性根据实际情况自行添加

实现

直接上代码

1 Python

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
import os

import tkinter as tk
from tkinter import filedialog
from tkinter import messagebox

import xlwings as xw

import time
import datetime

import sys

print("请选择要读取的文件夹")
foldr_patch = filedialog.askdirectory() # 选择文件夹

# 遍历文件夹及其子文件夹中的文件,并存储在一个列表中
# 输入文件夹路径、空文件列表[]
# 返回 文件列表Filelist,包含文件名(完整路径)
def get_filelist(dir, FileList):
newDir = dir
# 判断文件
if os.path.isfile(dir):
FileList.append(dir)
elif os.path.isdir(dir):
for s in os.listdir(dir):
newDir = os.path.join(dir, s)
get_filelist(newDir, FileList)
return FileList

if foldr_patch == '':
exit() #未选择文件夹时退出

items = get_filelist(foldr_patch, [])

# 打开Excel程序,默认设置:程序可见,只打开不新建工作薄,屏幕更新关闭
app = xw.App(visible = True, add_book = False)
app.display_alerts = False
app.screen_updating = False
#新建工作簿
newWb = app.books.add()
newWb.sheets.active.range('A1').value = '文件名'
newWb.sheets.active.range('A1').column_width = 45.5
newWb.sheets.active.range('B1').value = '创建时间'
newWb.sheets.active.range('B1').column_width = 15.88
newWb.sheets.active.range('C1').value = '最近修改时间'
newWb.sheets.active.range('C1').column_width = 15.88
newWb.sheets.active.range('A1:C1').api.Font.Bold = True #粗体
newWb.sheets.active.range('A1:C1').api.HorizontalAlignment = -4108 # -4108 水平居中
newWb.sheets.active.range('A1:C1').api.Borders(9).LineStyle = 1 # Borders(9) 底部边框,LineStyle = 1 直线
newWb.sheets.active.range('A1:C1').api.Borders(7).LineStyle = 1 # Borders(7) 左边框
newWb.sheets.active.range('A1:C1').api.Borders(8).LineStyle = 1 # Borders(8) 顶部框
newWb.sheets.active.range('A1:C1').api.Borders(10).LineStyle = 1 # Borders(10) 右边框
newWb.sheets.active.range('A1').api.Borders(10).LineStyle = 1
newWb.sheets.active.range('B1').api.Borders(10).LineStyle = 1
newWb.sheets.active.range('C1').api.Borders(10).LineStyle = 1

rowNum = 2

for item in items:

print(rowNum - 1)
print(os.path.basename(item))
newWb.sheets.active.range('A' + str(rowNum)).value = os.path.basename(item)
newWb.sheets.active.range('B' + str(rowNum)).value = time.strftime("%Y-%m-%d %H:%M:%S", time.localtime(os.path.getctime(item)))
newWb.sheets.active.range('C' + str(rowNum)).value = datetime.datetime.fromtimestamp(os.path.getmtime(item))

rowNum += 1

newWb.sheets.active.range('A2:K' + str(rowNum)).api.WrapText = True #自动换行

#两种当前路径保存方法
#①
# 脚本直接运行与打包成exe运行获取路径有所不同
#if getattr(sys, 'frozen', False):
# application_path = os.path.dirname(sys.executable)
#elif __file__:
# application_path = os.path.dirname(__file__)
#newWb.save(application_path + "\\result.xlsx")
#②
newWb.save("./result.xlsx")

newWb.close()

app.quit()

messagebox.showinfo("提示","程序执行完成")

2 VBA

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Public rowNum%

Sub getExcel()

Dim wk As Excel.Workbook

Dim filePath$
filePath = getFile()
If filePath = "" Then
Exit Sub
End If

Dim FSO As FileSystemObject
Dim fld As Folder

Dim Fl As file
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fld = FSO.GetFolder(filePath)

rowNum = 2
Call FolderTraversalInfo(fld)

'Workbooks(1).Sheets("数据收集").Activate
MsgBox "获取完成"

End Sub

'获取目标文件夹
Function getFile() As String
Dim sFile As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then sFile = .SelectedItems(1)
End With
getFile = sFile
End Function

'获取内容
Sub getInfo(filePath As String, fileName As String)
Set fs = CreateObject("Scripting.FileSystemObject")
Set file = fs.getFile(filePath)
Worksheets("数据收集").Cells(rowNum, 1) = fileName
Worksheets("数据收集").Cells(rowNum, 2) = file.DateCreated
Worksheets("数据收集").Cells(rowNum, 3) = file.DateLastModified

rowNum = rowNum + 1
End Sub

'遍历文件夹以及子文件夹(文件信息获取用)
Sub FolderTraversalInfo(rootfld As Object)
Dim file As Object
Dim fld As Object

For Each file In rootfld.Files
Call getInfo(file.Path, file.Name)
Next

If rootfld.SubFolders.Count = 0 Then
Exit Sub
Else
For Each fld In rootfld.SubFolders
Call FolderTraversalInfo(fld)
Next
End If
End Sub

文件格式以及执行结果展示

2 VBS

注意编码格式,因为代码中包含中文,需要以ANSI格式保存,不然会报错。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Set oExcel = CreateObject("Excel.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
Set myList = CreateObject("System.Collections.ArrayList")

currentpath = fso.GetFolder(".").Path

FilesTree(BrowseForFile)

'显示当前窗口
oExcel.Visible = True
'新建
oExcel.WorkBooks.Add

oExcel.Cells(1, 1).Value = "文件名"
oExcel.Cells(1, 2).Value = "创建时间"
oExcel.Cells(1, 3).Value = "最近修改时间"

For i = 0 to myList.count - 1
Set fn = fso.GetFile(myList.Item(i))
oExcel.Cells(i + 2, 1).Value = fn.Name
oExcel.Cells(i + 2, 2).Value = fn.DateCreated
oExcel.Cells(i + 2, 3).Value = fn.DateLastModified
'MsgBox fn.Name & vblf & fn.DateCreated & vblf & fn.DateLastModified
Next

'自动调整宽度(指定宽度一直出错,放弃)
oExcel.Sheets("Sheet1").columns(1).AutoFit()
oExcel.activeSheet.columns(2).AutoFit()
oExcel.activeSheet.columns(3).AutoFit()

'另存为
oExcel.activeWorkBook.SaveAs(currentpath & "\result.xlsx")

'选择文件夹
Function BrowseForFile()
'通过Excel实现文件选择
Set FileDialog = oExcel.FileDialog(4) '4 选择文件夹
FileDialog.show()
BrowseForFile = FileDialog.SelectedItems(1)
End Function

'遍历文件夹
Function FilesTree(sPath)
'遍历一个文件夹下的所有文件夹文件夹
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFso.GetFolder(sPath)
Set oSubFolders = oFolder.SubFolders

Set oFiles = oFolder.Files
For Each oFile In oFiles
myList.add(oFile.Path)
Next

For Each oSubFolder In oSubFolders
FilesTree(oSubFolder.Path)'递归
Next

Set oFolder = Nothing
Set oSubFolders = Nothing
Set oFso = Nothing
End Function

尝试过文件数量超过2万+的文件的读取,VBA的效率最高,推荐使用