excel - VBA - 列出给定文件夹及其所有子文件夹中给定扩展名的文件名,直到最后一级
问题描述
您好,我正在尝试通过扩展名从多个文件夹及其子文件夹中获取特定文件,但我在执行此任务时遇到了麻烦。到目前为止我所拥有的是:
Sub ListFiles()
'Declare variables
Dim i As Long
Dim fileName As Variant
fileName = Dir("J:\BREAKDOWNS\*.PDF")
i = 2
While fileName <> ""
Cells(i, 1).Value = Left(fileName, Len(fileName) - 4)
i = i + 1
fileName = Dir
Wend
End Sub
有人可以帮忙吗?
附言
我需要的和到目前为止我得到的是
folder = "J:\BREAKDOWNS\*.PDF"
sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & folder & ibox & """ /s /a /b").StdOut.ReadAll, vbCrLf)
Sheets(1).Cells(2, 1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
但它返回完整地址,我只需要没有扩展名的文件名。
解决方案
试试下面的代码,它列出了给定文件夹中给定扩展名的文件名及其所有子文件夹,直到新添加的工作表上的最后一级
学分:https ://www.youtube.com/watch?v=ddA2_SOaq14
Option Explicit
Sub List_File_Names()
'This macro lists file names of the given extensions in the given folder and _
its all subfolders down to last level on a newly added sheet
'https://stackoverflow.com/questions/68812888/ _
vba-list-file-names-of-the-given-extensions-in-the-given-folder-and-its-all-su
'reference - https://www.youtube.com/watch?v=ddA2_SOaq14
Dim FNameStr As String, ExtStr As String, ExrArr, sn, nWs As Worksheet
Dim regex As Object, mc As Object, f As String, i As Long
Dim fldr As FileDialog
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.Show
f = fldr.SelectedItems(1)
f = f & "\"
Set regex = CreateObject("VBScript.regexp")
regex.ignorecase = False
regex.Global = True
ExtStr = InputBox("Enter extensions of filesnames to be listed delimited by comma", _
Default:=".xlsx,.pdf")
ExrArr = Split(ExtStr, ",")
FNameStr = ""
If ExtStr <> "" Then
For i = LBound(ExrArr) To UBound(ExrArr)
FNameStr = FNameStr & (CreateObject("wscript.shell").exec("cmd /c Dir /s /b """ & _
f & """ | findstr """ & ExrArr(i) & """ ").stdout.readall)
Next i
Else
FNameStr = FNameStr & (CreateObject("wscript.shell").exec("cmd /c Dir /s /b """ & _
f & """").stdout.readall)
End If
regex.Pattern = "\S[^\n]+\\" 'to remove folder names from full file name
sn = Split(Replace(regex.Replace(FNameStr, ""), vbCrLf, "|"), "|")
Set nWs = Worksheets.Add(Before:=Sheets(1))
nWs.Cells(1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub
推荐阅读
- asp.net-mvc - 无法将 Bootstrap 图标放在选择框中不起作用
- rest - 邮件任务配置(activiti rest)
- angular - 如果输入无效则禁用按钮
- hapi - 使用 JAVA 将 HL7 转换为 JSON
- c++ - 试图找出向量中的任何元素是否为假
- java - Gson序列化后MySql给出语法错误
- sql - 使用 regexp_like 在 dba_source 中搜索文本
- javascript - 如何使用 JavaScript 拆分数组中的字符?
- cassandra - 在某些情况下,cassandra 中的增量整数是否可能?
- excel - 在 Excel 中比较三列并删除整行