VBA - 列出给定文件夹及其所有子文件夹中给定扩展名的文件名，直到最后一级

Question

您好，我正在尝试通过扩展名从多个文件夹及其子文件夹中获取特定文件，但我在执行此任务时遇到了问题。到目前为止我所拥有的是：

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)

但它返回完整地址，我只需要没有扩展名的文件名。

Answer 1

尝试下面的代码，它列出了给定文件夹中给定扩展名的文件名及其所有子文件夹，直到新添加的工作表上的最后一级

致谢：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