查看: 19836|回复: 20
提取指定目录的文件夹名和文件名怎么实现？
阅读权限10
在线时间 小时
找了段代码，可以提取出来指定目录的文件夹名，但是总是少提取一个名字（这个文件夹内有14个文件夹，但是提取出来的名字只有13个，少了一个），请帮忙看下要怎么修改啊？
Snap1.jpg (52.51 KB, 下载次数: 171)
16:30 上传
Sub getFldList1()
& & Dim Fso, Fld
& & Dim Arr(999), k%
& & Set Fso = CreateObject(&Scripting.FileSystemObject&)
& & Set Fld = Fso.getfolder(CreateObject(&Shell.Application&).BrowseForFolder(0, &请选择文件夹&, 0, &&).Self.Path & &\&)
& & For Each fd In Fld.subfolders
& && &&&k = k + 1
& && &&&Arr(k) = fd.Name
& & [A1].Resize(k) = Application.Transpose(Arr)
另外再求一段提取指定文件夹内的所有文件名的代码
阅读权限95
在线时间 小时
第一个问题是数组声明错误，应该从1开始：
Dim Arr(1 To 999)Sub getFldList1()
& & Dim Fso, Fld
& & Dim Arr(1 To 999), k%
& & Set Fso = CreateObject(&Scripting.FileSystemObject&)
& & Set Fld = Fso.getfolder(CreateObject(&Shell.Application&).BrowseForFolder(0, &请选择文件夹&, 0, &&).Self.Path & &&)
& & For Each fd In Fld.subfolders
& && &&&k = k + 1
& && &&&Arr(k) = fd.Name
& & Next
& & [A1].Resize(k) = Application.Transpose(Arr)
End Sub
复制代码
阅读权限95
在线时间 小时
第二个问题：Sub 提取指定文件夹内的所有文件名() '含所有子文件夹内的文件
& & Dim Fso As Object, arrf$(), mf&
& & Set Fso = CreateObject(&Scripting.FileSystemObject&)
& & Call GetFiles(CreateObject(&Shell.Application&).BrowseForFolder(0, &请选择文件夹&, 0, &&).Self.Path, Fso, arrf, mf)
& & [b1].Resize(mf) = Application.Transpose(arrf)
& & Set Fso = Nothing
End Sub
Private Sub GetFiles(ByVal sPath$, ByRef Fso As Object, ByRef arrf$(), ByRef mf&)
& & Dim Folder As Object
& & Dim SubFolder As Object
& & Dim File As Object
& & Set Folder = Fso.GetFolder(sPath)
& &
& & For Each File In Folder.Files
& && &&&mf = mf + 1
& && &&&ReDim Preserve arrf(1 To mf)
& && &&&arrf(mf) = File.Name
& & Next
& & For Each SubFolder In Folder.SubFolders
& && &&&Call GetFiles(SubFolder.Path, Fso, arrf, mf)
& & Next
& & Set Folder = Nothing
& & Set File = Nothing
End Sub
复制代码
阅读权限10
在线时间 小时
zhaogang1960 发表于
第一个问题是数组声明错误，应该从1开始：
Dim Arr(1 To 999)
谢谢版主，这次没少了。。
阅读权限10
在线时间 小时
zhaogang1960 发表于
第二个问题：
谢谢了，还可以提个不情之请么？我想把窗口弹出的界面改成可以选择桌面的那种，可以实现不？我在楼下截个图上传，还有就是显示可以从第二行开始不？麻烦在关键代码后面注释下，我不是太懂，谢谢啦
阅读权限10
在线时间 小时
版主，这是我想要弹出的窗口界面
(43.11 KB, 下载次数: 186)
17:05 上传
阅读权限95
在线时间 小时
liuxiangcs 发表于
版主，这是我想要弹出的窗口界面Sub 提取指定文件夹内的所有文件名() '含所有子文件夹内的文件
& & Dim Fso As Object, arrf$(), mf&, p$
& & With Application.FileDialog(msoFileDialogFolderPicker)
& && &&&If .Show = False Then Exit Sub
& && &&&p = .SelectedItems(1) & &&
& & End With
& & Set Fso = CreateObject(&Scripting.FileSystemObject&)
& & Call GetFiles(p, Fso, arrf, mf)
& & [b1].Resize(mf) = Application.Transpose(arrf)
& & Set Fso = Nothing
End Sub
复制代码
阅读权限10
在线时间 小时
zhaogang1960 发表于
可以从第二行开始不？我前面那个提取文件夹名的弹出窗口是不是也可以改成这样的？
阅读权限95
在线时间 小时
liuxiangcs 发表于
可以从第二行开始不？我前面那个提取文件夹名的弹出窗口是不是也可以改成这样的？
第二行开始修改[a2].Resize(k)：
Sub getFldList1()
& & Dim Fso, Fld, p$
& & Dim Arr(1 To 999), k%
& & With Application.FileDialog(msoFileDialogFolderPicker)
& && &&&.Title = &请选择文件夹&
& && &&&If .Show = False Then Exit Sub
& && &&&p = .SelectedItems(1) & &\&
& & End With
& & Set Fso = CreateObject(&Scripting.FileSystemObject&)
& & Set Fld = Fso.GetFolder(p)
& & For Each fd In Fld.SubFolders
& && &&&k = k + 1
& && &&&Arr(k) = fd.Name
& & [a2].Resize(k) = Application.Transpose(Arr)
阅读权限10
在线时间 小时
zhaogang1960 发表于
第二行开始修改[a2].Resize(k)：
Sub getFldList1()
& & Dim Fso, Fld, p$
知道了，2个都已经改了，谢谢啦，我完全没任何基础。。。麻烦版主了
最新热点 /2
京东ExcelHome部分图书，每满100减30，可叠加使用满150减50优惠券，叠券后相当于满300减140。活动日期，即日起至9月18日。
ExcelHome每周都有线上直播公开课，
国内一流讲师真身分享，高手贴身答疑，
赶不上直播还能看录像，
关键居然是免费的！
厚木哥们都已经这么努力了，
你还好意思说学不好Office。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 6207|回复: 4
请高手指教 VBA自动指定提取文件夹内的文件名
Sub rename()
& & MsgBox &请选择要重命名所在的文件夹&
& & With Application.FileDialog(msoFileDialogFolderPicker)
& && &&&.AllowMultiSelect = False
& && &&&.Show
& && && && &reNamePath = .SelectedItems(1)
& && && && &If Right(reNamePath, 1) && &\& Then
& && && && &reNamePath = reNamePath + &\&
& && && && &End If
& & End With
& & Range(&a2&).End(xlDown).Select
& & rCount = ActiveCell.Row
& & Dim fs
& & Set fs = CreateObject(&Scripting.FileSystemObject&)
& & For r = 2 To rCount
& && &&&oName = reNamePath & Cells(r, 1) & &.jpg&
& && &&&If fs.FileExists(oName) Then
& && && && &nName = reNamePath & Cells(r, 2) & &.jpg&
& && && && &Name oName As nName
& && &&&End If
& & Next r
找了几个vba提取文件夹内的文件名都要把excel文件放在同一个文件夹里，
能不能像上面那样，点击时出现 &请选择提取文件名所在的文件夹&的对话框，生成文件名在A列。
就不用每次都在同一个文件夹里建excel文件。
请高手指教一下
试试这个。Sub 提取文件名并建立超链接()
Cells.ClearContents '清空数据
Set Fold = CreateObject(&shell.application&).BrowseForFolder(0, &请选择存放数据的文件夹：&, 0, &&) '选择文件夹
& & If Fold Is Nothing Then Exit Sub '如果没选择文件夹就退出循环
& & mp = Fold.Items.Item.Path & &\& '路径
n = 1
mf = Dir(mp & &\*.*&) '文件名
Do While mf && && And mf && ThisWorkbook.Name '遍历
Cells(1, 1) = &序号&
Cells(1, 2) = &提取文件名显示如下&
Cells(n + 1, 2) = mf '数据写入
Cells(n + 1, 1) = n '编号
mf = Dir '找寻下一个文件
n = n + 1 '计数、累加
Loop
& & ActiveWorkbook.Save '保存
End Sub
复制代码
非常可以，谢谢了，还有就是能做一下把文件的扩展名去掉，行吗
本帖最后由 ligh1298 于
15:44 编辑
楼主，如果满意，请设置成“最佳答案”Sub 提取文件名()
Cells.ClearContents '清空数据
Set Fold = CreateObject(&shell.application&).BrowseForFolder(0, &请选择存放数据的文件夹：&, 0, &&) '选择文件夹
If Fold Is Nothing Then Exit Sub '如果没选择文件夹就退出循环
mp = Fold.Items.Item.Path & &\& '路径
n = 1
mf = Dir(mp & &\*.*&) '文件名
Do While mf && && And mf && ThisWorkbook.Name '遍历
Cells(1, 1) = &序号&
Cells(1, 2) = &提取文件名显示如下&
k = Application.Find(&.&, mf) - 1
Cells(n + 1, 2) = Left(mf, k) '数据写入
Cells(n + 1, 1) = n '编号
mf = Dir '找寻下一个文件
n = n + 1 '计数、累加
Loop
ActiveWorkbook.Save '保存
End Sub
复制代码
Powered by你的位置：
按键精灵读取excel一个单元格内数据后如何读取其中几位数字
21:56:49 |
来源: 按键精灵资源站
读取excel一个单元格内数据后如何读取其中几位数字
譬如：A1& && && &
& && && & 身份证号18位
我要读取他的15位
或者一段文字，我要读取其中几个字
求高手指教。将指定文件夹下文件的文件名导入excel中_百度文库
两大类热门资源免费畅读
续费一年阅读会员，立省24元！
将指定文件夹下文件的文件名导入excel中
&&简单实用的小功能,可能平时你没留意,但需要的时候就有大作用。
阅读已结束，下载文档到电脑
想免费下载本文？
定制HR最喜欢的简历
你可能喜欢