Search for a match files using value from selected cell in Folder or Subfolders

[mana]

Option Explicit


Sub test2()
    Dim dic As Object
    Dim fdg As FileDialog, p As String
    Dim cmd As String, s, k As Long
    Dim fn As String
    Dim c As Range, msg As String
     
    Set fdg = Application.FileDialog(msoFileDialogFolderPicker)
    If Not fdg.Show Then Exit Sub
    p = fdg.SelectedItems(1) & "\"
    
    Set dic = CreateObject("scripting.dictionary")
    
    cmd = "cmd /c dir """ & p & "*.*"" /b/s/a-d"
    s = Split(CreateObject("wscript.shell").exec(cmd).stdout.readall, vbCrLf)
    For k = 0 To UBound(s) - 1
        fn = Dir(s(k))
        dic(fn) = dic(fn) & " , " & s(k)
    Next
   
    For Each c In Selection
        fn = c.Value
        s = Filter(dic.keys, fn)
        msg = ""
        If UBound(s) > -1 Then
            For k = 0 To UBound(s)
                msg = msg & dic(s(k))
            Next
            msg = "Found in " & Mid(msg, 3)
        Else
            msg = "not found"
        End If
        c.Offset(, 1).Value = msg
    Next


End Sub