CODEWITHSUNDEEP
excelvbashelldirectory
Eduards
Eduards

Reputation: 78

VBA - list file names of the given extensions in the given folder and its all subfolders down to last level

Hello I am trying to get specific files by extension from multiple folders and their subfolders and I am having trouble with this task. WHat I have so far is:

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

Could someone, please, help?

P.S.

What I need and what I got so far is

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)

But it returns teh full address, where I need just teh filename without extension even.

Upvotes: 1

Views: 1147

Answers (1)

Naresh
Naresh

Reputation: 3034

Try below code which lists file names of the given extensions in the given folder and its all subfolders down to last level on a newly added sheet

Credits: 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

Upvotes: 1

Related Questions