本帖最后由 独行剑侠 于 2024-11-6 18:41 编辑
简单说明过程:
手上超过200多块移动硬盘,想要快速统计每一块硬盘里的内容,而且还想快速的放在Excel表格里。
具体为啥要统计这个?……反正领导需要。
反正看同事在一次次的Ctrl CV就头疼,你们就这么工作的???
太会了……
太会摸鱼了,像我这么喜欢效率的人,怎么能忍受这个???
好了,先叙述要求
Excel表格第一行要求是硬盘名称。
从第二行开始【文件夹名称】【硬盘名称+文件夹名称】【文件(夹)大小】
另外【硬盘名称+文件夹名称】要求鼠标点击即可进入硬盘文件夹。
因为不需要遍历子文件夹,只需要统计硬盘打开后第一层文件夹以及文件即可。
实现方式。Excel+VB
先去 文件→选项→自定义功能区→勾选√开发工具 确认
在Excel顶部菜单栏点击 开发工具→Visual Basic
输入以下脚本内容
[JavaScript] 纯文本查看 复制代码 Sub GetFirstLevelFolderAndFileDetails()
Dim fso As Object
Dim folder As Object
Dim subFolder As Object
Dim file As Object
Dim ws As Worksheet
Dim lastRow As Long
Dim drivePath As String
Dim driveName As String
' 弹出文件夹选择对话框
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "选哪个硬盘进行筛选?"
If .Show = -1 Then
drivePath = .SelectedItems(1)
Else
MsgBox "未选择硬盘盘符,后边我咋搜索?!"
Exit Sub
End If
End With
' 创建文件系统对象
Set fso = CreateObject("Scripting.FileSystemObject")
' 获取指定硬盘盘符
Set folder = fso.GetFolder(drivePath)
' 获取硬盘名称
driveName = fso.GetDrive(fso.GetDriveName(drivePath)).VolumeName
' 设置工作表
Set ws = ThisWorkbook.Sheets(1)
ws.Cells.Clear
' 合并第一行四个单元格并标注硬盘名称
ws.Range("A1:D1").Merge
ws.Cells(1, 1).Value = "硬盘名称: " & driveName
ws.Cells(1, 1).Font.Bold = True
ws.Cells(1, 1).HorizontalAlignment = xlCenter
' 写入表头
ws.Cells(2, 1).Value = "名称"
ws.Cells(2, 2).Value = "路径"
ws.Cells(2, 3).Value = "类型"
ws.Cells(2, 4).Value = "大小"
' 初始化行号
lastRow = 3
' 遍历第一层子文件夹
On Error Resume Next ' 开始错误处理
For Each subFolder In folder.SubFolders
If Err.Number = 0 Then
' 跳过特定文件夹
If subFolder.Name <> "System Volume Information" And subFolder.Name <> "$RECYCLE.BIN" Then
ws.Cells(lastRow, 1).Value = subFolder.Name
ws.Hyperlinks.Add Anchor:=ws.Cells(lastRow, 2), Address:=subFolder.Path, TextToDisplay:=driveName & "\" & subFolder.Name
ws.Cells(lastRow, 3).Value = "文件夹"
' 计算文件夹大小
ws.Cells(lastRow, 4).Value = FormatFileSize(GetFolderSize(subFolder))
lastRow = lastRow + 1
End If
Else
' 处理权限被拒绝的情况
Err.Clear
End If
Next subFolder
On Error GoTo 0 ' 结束错误处理
' 遍历第一层文件
On Error Resume Next ' 开始错误处理
For Each file In folder.Files
If Err.Number = 0 Then
ws.Cells(lastRow, 1).Value = file.Name
ws.Hyperlinks.Add Anchor:=ws.Cells(lastRow, 2), Address:=file.Path, TextToDisplay:=driveName & "\" & file.Name
ws.Cells(lastRow, 3).Value = "文件"
ws.Cells(lastRow, 4).Value = FormatFileSize(file.size)
lastRow = lastRow + 1
Else
' 处理权限被拒绝的情况
Err.Clear
End If
Next file
On Error GoTo 0 ' 结束错误处理
' 调整列宽
ws.Columns("A:D").AutoFit
MsgBox "文件夹和文件信息已提取完成!"
End Sub
Function GetFolderSize(ByVal folder As Object) As Double
Dim file As Object
Dim subFolder As Object
Dim folderSize As Double
' 初始化文件夹大小
folderSize = 0
' 遍历文件夹中的文件
On Error Resume Next ' 开始错误处理
For Each file In folder.Files
If Err.Number = 0 Then
folderSize = folderSize + file.size
Else
' 处理权限被拒绝的情况
Err.Clear
End If
Next file
' 遍历子文件夹
For Each subFolder In folder.SubFolders
If Err.Number = 0 Then
folderSize = folderSize + GetFolderSize(subFolder)
Else
' 处理权限被拒绝的情况
Err.Clear
End If
Next subFolder
On Error GoTo 0 ' 结束错误处理
GetFolderSize = folderSize
End Function
Function FormatFileSize(size As Double) As String
If size >= 1073741824 Then
FormatFileSize = Format(size / 1073741824, "0.00") & " GB"
ElseIf size >= 1048576 Then
FormatFileSize = Format(size / 1048576, "0.00") & " MB"
Else
FormatFileSize = Format(size, "0.00") & " B"
End If
End Function
自动获取硬盘信息(文件夹-路径-大小).zip
(23.11 KB, 下载次数: 42)
现成的直接下载,解压即用,记得选择启用宏
保存,格式XLSM
叉×掉Visual Basic页面,在在Excel顶部菜单栏点击 插入形状。
在表格内画个长方形当按钮,右键→指定宏→选择刚刚设定好的宏(初次设置应该只有一个)→点击确认。
此时,点击按钮,就会跳出选择硬盘盘符的提示
选择硬盘→点击确定
等待……
就会在表格内出现以下内容
好了,你们看看,200多块硬盘,一上午就解决了。
他们说这个任务至少三个人加班加点儿,也得一星期才能做完?
我只需要一上午!
领导不得夸夸我升职加薪?
不说了,我要去汇报了。
我!!!做好加薪准备啦! |