背景做网站公司,家具公司网页设计,设计网站公司搜索y湖南岚鸿知名,福建省建设人才市场网站小伙伴们#xff0c;之前有跟大家分享过Power Query获取文件夹内文件清单及其属性的方法【Excel快速获取文件列表及文件属性】。今天教大家通过VBA代码来实现同样的功能#xff0c;提取文件夹内的文件信息更加灵活#xff0c;只要选择对应的文件夹即可。实现效果操作方法之前有跟大家分享过Power Query获取文件夹内文件清单及其属性的方法【Excel快速获取文件列表及文件属性】。今天教大家通过VBA代码来实现同样的功能提取文件夹内的文件信息更加灵活只要选择对应的文件夹即可。实现效果操作方法1. 在Excel界面按快捷键ALTF11进入VBE界面。2. 在VBE工程里面插入一个模块。3. 将以下代码复制到模块中。4. 关闭VBE界面返回Excel界面从开发工具中找到表单控件插入一个按钮。5. 按钮指定宏[GetFileList]即可。详细的操作过程以下是实现本次功能要用到的VBA代码有详细注解应用非常广泛建议收藏备用。Sub GetFileList() 定义文件夹路径变量 Dim PathSht As String 清空模板文件里面的数据 ActiveSheet.Range(A3:H65536).Clear 调用文件路径获取方法弹出文件夹选择对话框 With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then PathSht .SelectedItems(1) Else Exit Sub End With 先获取当前文件夹内的文件 GetFileFromFolder PathSht 获取子文件夹内的文件 GetFolderList PathShtEnd Sub方法一从文件夹里面提取文件和文件信息Function GetFileFromFolder(folder_name) 定义文件操作对象 Dim fso As Object 设置文件操作对象 Set fso CreateObject(Scripting.FileSystemObject) 所有文件类型如果只要Excel文件则修改为 FileType *.xls* FileType *.* 查找第一个文件 sPath Dir(folder_name FileType) 循环到没有文件为止 Do While Len(sPath) 将文件对象赋值给objfile方便后续获取对应属性数据 Set objfile fso.GetFile(folder_name sPath) 当前活动工作表 With ActiveSheet 定位到第一个空行位置 endrow .Range(A65536).End(xlUp).Row 1 A列存放文件夹名称 .Range(A endrow) folder_name B列存放文件名称 .Range(B endrow) sPath C列存放文件类型 .Range(C endrow) objfile.Type D列存放文件大小 .Range(D endrow) FormatNumber(objfile.Size / 1024, -1) K E列存放文件创建时间 .Range(E endrow) objfile.DateCreated F列存放文件修改时间 .Range(F endrow) objfile.DateLastModified G列存放文件访问时间 .Range(G endrow) objfile.Datelastaccessed H列创建超链接支持点击打开文件 ActiveSheet.Hyperlinks.Add Anchor:.Range(H endrow), Address:folder_name sPath, ScreenTip:单击打开 sPath, TextToDisplay:打开文件 End With 查找下一个文件 sPath Dir LoopEnd Function方法二递归方式循环遍历子文件夹Function GetFolderList(strFolder) 定义文件夹操作对象 Dim fso, objFolder, objSubFolder 设置文件操作对象 Set fso CreateObject(Scripting.FileSystemObject) 判断文件夹是否存在 If fso.FolderExists(strFolder) Then 定义为父文件夹 Set objFolder fso.getFolder(strFolder) 定义为子文件夹 Set objSubFolder objFolder.subFolders 每一个在父文件夹中的子文件夹 For Each oSubFolder In objSubFolder 从文件夹里面获取文件 GetFileFromFolder oSubFolder 继续获取当前文件夹的子文件夹 GetFolderList oSubFolder.Path Next End IfEnd Function最后提个醒:别忘了把你的Excel文件另存为加载宏工作簿这样才可变成永久可以的工具。
