How Find All files within a folder and sub folder with multi extension

[roykana]

Dear ALL,

the code below is appropriate but can only be one extension and I want with multi extension by only modifying a little in the code below.


Thanks

Sub Find_Files_Path()
    Dim fldr As FileDialog
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    fldr.Show
    f = fldr.SelectedItems(1)
    f = f & "\"
    ibox = InputBox("File Must Contain (Note * wildcards can be used)", , "*.jpg*")
    On Error GoTo ext
    sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & f & ibox & """ /s /a /b").stdout.readall, vbCrLf)
    Sheets(1).Cells(1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
ext:
End Sub

 

[Trebor76]

Hi roykana,

Try this:

Option Explicit
Sub Find_Files_Path()
    Dim fldr As FileDialog, f As String, ibox As String, sn() As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    fldr.Show
    f = fldr.SelectedItems(1)
    f = f & "\"
    'ibox = InputBox("File Must Contain (Note * wildcards can be used)", , "*.jpg*")
    On Error GoTo ext
    'sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & f & ibox & """ /s /a /b").stdout.readall, vbCrLf)
    sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & f & "*" & """ /s /a /b").stdout.readall, vbCrLf)
    Sheets(1).Cells(1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
ext:
End Sub