关灯
开启左侧

Excel使用宏对任意指定的文件夹内的文件提取目录,并生成...

[复制链接]
哥不帅但很坏 发表于 2019-4-21 09:58:22 | 显示全部楼层 |阅读模式 打印 上一主题 下一主题
 
Excel使用宏对任意指定的文件夹内的文件提取目录,并生成超链接(目录位置不限)
    经常都是来当搬运工的,因为自己并不会做些什么,现在给大家分享一下这个吧,应该会有不少人会有用处
    工作中,经常会碰到收集文件,有时需要整理判断缺少了哪个的,网上找到了一个可以使用的宏代码,可以对指定的文件夹获取其中的文件列表,在此基础上,请【excel home技术论坛】的【白薯beyond】帮忙做了超链接及自己选定目录的优化,可以不用把这个带有宏的文件放在需要生成目录的文件夹里面了,并且生成的目录中,可以直接超链接打开对应的文件。我自己又做了部分公式,可以判断收集到的文件中是否有自己需要的文件。
    因为带有宏,仅能用于Microsoft Office 中的Excel,如果喜欢用WPS的朋友请先安装VBA后再使用。
    当然也有朋友喜欢用批处理之类的,但是个人觉得能省一步是一步了{:1_907:}
    不喜轻喷
因为文件没有办法上传,请需要的朋友自行下载代码使用。需要交流的朋友移步下面链接:
Excel 求助一个VBA代码(提取指定文件夹内的文件,列表并生成超链接)-ExcelVBA程序开发-ExcelHome技术论坛 -  
http://club.excelhome.net/thread-1471196-1-1.html





文中所用代码如下:
Sub PFL() 'return file names under specific folder
Cells(1, 1) = "目录"
Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Clear
Dim fp, Fname As String, i As Integer, obmapp As Object
i = 1
Set obmapp = CreateObject("Shell.Application").BrowseForFolder(0, "Select PDF Folder", 0, 0)
If Not obmapp Is Nothing Then
     fp = obmapp.self.Path & "\*.*"
Else
    MsgBox "You didn`t select any folers"
     Exit Sub
End If
Fname = Dir(fp)
Do While Fname <> ""
     ThisWorkbook.Sheets(1).Range("A" & i + 1) = Left(Fname, Len(Fname))
     ActiveSheet.Hyperlinks.Add Anchor:=Sheets(1).Range("A" & i + 1), Address:=obmapp.self.Path & "\" & Fname, TextToDisplay:=Fname
     Fname = Dir
     i = i + 1
Loop
End Sub
回复

使用道具 举报

 
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则


排行榜

关注我们:QQ交流群

官方微信

APP下载

全国服务热线:

4000-888-888

公司地址:上海市嘉定区

运营中心:上海市嘉定区百达国际大厦25楼

邮编:200000 Email:admin@mr-technos.com

Copyright   ©2015-2018  先森科技Powered by©Discuz!技术支持:先森科技     ( 浙ICP备18046157号-1 )|网站地图