哈喽,大家好,前两天,我们部门的文老师组织学生在机房期末考试一个班的《交换机与路由器的配置和管理》这门课程,提交的电子期末作业全部上传于ftp服务器上,当时我参与了监考,文老师交代提交一个让学生登记提交的文件情况(自己在服务器上的文件夹提交了多少个文件)。当时,我们也照做了,但是,我在登记的过程中发现这种用手工登记的方法确实效率比较低。于是乎,我在琢磨:能否用Excel的强大功能智能解决这个问题呢?事实上,像文老师这样手工登记的老师还很有一部份。显然,这是个大家都共同的问题,所以解决这个问题,就有着很强的现实意义:有效地挖掘、展示和收集学生班级提交的期末考试电子作业的情况,我们可以对一个给定目录(文件夹)下隶属的一级各个子目录(每个学生自行建立的个人文件夹,其文件夹命名的格式:学号后两位 学生姓名)下隶属的所有文件资源详情进行一个列表显示分析,这样一来,教师即可轻松地了解学生提交的电子期末作业情况(例如,每个学生提交了多少文件及提交了哪些文件的问题)。
很巧合的是,上一期我刚刚在头条做过一个显示一个文件夹下所有文件信息列表数据的问题,我们完全可以将上次的作品加以改造以满足我们的功能,只不过呢,上次是在每一行上显示逐个显示所有的隶属文件信息列表,这次不同的上在每行显示的每个学生的姓名文件夹,同时在该学生的姓名文件夹显示的本行的右侧列举该省提交的文件列表情况。可以说,本次在纵横方向上都实现列举信息的功:纵向列举学生姓名文件夹,横向上列举他们对应提交的文件列表情况。
上次,大家可能看到过给定的文件夹目录上通过获取我们设计的作品所在的当前路径进行操作的。显然,指定目录的灵活度不是很好,能否通过文件对话框的形式灵活选定文件目录进行操作来弥补这个缺陷呢?答案肯定是可以的,这样不仅起到交互友好作用,大大提高了定位目录文件夹的效率。
带着这些兴奋,我们马上来一一解决吧。
一、Excel中简单的界面设计
布局两个简单的交互按钮,如下图
图1 简单的界面
二、功能代码及必要的注释
模块1中的代码如下:
Sub Generate_Folders_Display_In_Worksheet() '在工作表镇南关生成一级目录展示
Dim sFolderPath As String, rg As Range
Set rg = Cells(1, 1)
Set fd = Application.FileDialog(msoFileDialogFolderPicker) '创建文件对话框对象,用于选择文件夹
k = fd.Show '打开文件对话框
If k = 0 Then '在对话框中单击了“取消”按钮
MsgBox "你选择了取消选定文件夹的操作", vbInformation, "提示"
Exit Sub
Else '否则,选择了文件夹,则作如下操作
Dim rg1 As Range
max_row = [A65535].End(xlUp).Row
'以下If是为了判断重新加载数据时原工作表是否有数据,如果有,则执行下面的清除操作;否则就直接加载数据
If max_row > 1 Then
Set rg1 = Range("A2:C" & max_row)
rg1.ClearContents
Set rg1 = Nothing '让rg1指派为Nothing意思是回收内存资源
End If
sFolderPath = fd.SelectedItems.Item(1) '取出选中的文件夹名
GetAll_FirstLevel_SubFolders_Of_OneFolder_Horizontal_Display_Files sFolderPath, rg
max_row = [A65535].End(xlUp).Row
Range("A2:A" & max_row).Sort Key1:=Range("A2"), Order1:=xlAscending '排序
MsgBox "加载选定的外部文件夹下的一级子目录文件夹数据成功!", vbInformation, "提示"
End If
End Sub
Sub Erse_Datas() '删除工作表中已经加载的数据操作
Dim rg As Range
With Sheets("Sheet1")
max_row = .[A65535].End(xlUp).Row
If max_row < 2 Then
MsgBox "无数据了,禁止再次删除操作!", vbInformation, "提示"
Else
Set rg = .Range("A2:C" & max_row)
rg.ClearContents
Set rg = Nothing '让rg指派为Nothing意思是回收内存资源
MsgBox "删除数据成功!", vbInformation, "提示"
End If
End With
End Sub
'--------------------------------------------------------------------------------------------------
'获取某文件夹下的所有一级子目录(以纵向方式显示于Excel工作表中),并以横向方向显示该一级子目录内部所有文件
'--------------------------------------------------------------------------------------------------
Sub GetAll_FirstLevel_SubFolders_Of_OneFolder_Horizontal_Display_Files(sFolderPath As String, rg As Range)
On Error Resume Next
Dim f As String, rg_1 As Range
Dim filefolder() As String
Dim i, k
i = 1: k = 1
ReDim filefolder(1 To i)
ObjectFileName = ThisWorkbook.Name
filefolder(1) = sFolderPath & "\"
'-- 获得所有子目录
f = Dir(filefolder(i), vbDirectory)
Do Until f = ""
If InStr(f, ".") = 0 Then
k = k 1
ReDim Preserve filefolder(1 To k)
rg.Offset(k - 1, 0) = f
filefolder(k) = filefolder(i) & f & "\"
End If
f = Dir
Loop
For i = 2 To k
GetAllFile_Horizontal_Display filefolder(i), rg.Offset(i - 1, 0)
Next
End Sub
'--------------------------------------------------------------
'获取某文件夹下的所有文件和子目录下的文件,在Excel中以横向方向展示
'--------------------------------------------------------------
Sub GetAllFile_Horizontal_Display(sFolderPath As String, rg As Range)
On Error Resume Next
Dim f As String, ObjectFileName As String
Dim file() As String
Dim i, k, x
x = 0: i = 1: k = 1
ReDim file(1 To i)
ObjectFileName = ThisWorkbook.Name
file(1) = sFolderPath & "\"
'-- 获得所有子目录
Do Until i > k
f = Dir(file(i), vbDirectory)
Do Until f = ""
If InStr(f, ".") = 0 Then
k = k 1
ReDim Preserve file(1 To k)
file(k) = file(i) & f & "\"
End If
f = Dir
Loop
i = i 1
Loop
'-- 获得所有子目录下的所有文件
s = ""
For i = 1 To k
f = Dir(file(i) & "*.*") '通配符*.*表示所有文件,*.xlsx Excel文件
Do Until f = ""
If f <> ObjectFileName Then
x = x 1
s = s & f & ";"
End If
f = Dir
Loop
Next
s = Left(s, Len(s) - 1)
rg.Offset(0, 1) = x
rg.Offset(0, 2) = s
End Sub
三、运行测试
(一)点击<查看提交文件情况>按钮准备启动打开文件夹对话框
图2 准备启动打开文件夹对话框
(二)点击上面对话框的<X>按钮,将取消操作
图3 取消所有操作
(三)选定需要的目录:重新点击工作表上的<查看提交文件情况>按钮准备确定从打开文件夹对话框选的目录
图4 选定打开文件夹对话框中的目录
(四)点击开文件夹对话框按钮<确定>后程序运行的结果
图5 程序运行结果
(五)点击按钮<删除左侧载入的数据>,将清除在工作表中所有展示的目录下文件列表信息的数据操作
图6 清除在工作表中所有展示的目录下文件列表信息的数据
(六)如果再次点击按钮<删除左侧载入的数据>,将禁止清除空数据的操作
图7 禁止清除空数据
好了,我们今天就此给大家分享倒这里吧,希望能借助这个方法对大家的工作需要带来方便。
最后,仍然非常感谢大家长期以来对我的头条原创作品的关注(头条号:跟我学Office高级办公)、推广和点评哦!谢谢!
,