Search file name from folder and Subfolder if Exist or not

Question

I've been working on a code and can't seem to find a way to make this work, here it goes: I'll have column A with value that I will select cell to search a match on our network folder/subfolder if it exist or not then on next column if the value exist on the folder it will write File Exist.

My code that currently work only search on Main selected Folder only and not including subfolder.

Sub Search_myFolder_Network()
    Dim myFolder As String
    Dim myFileName As String
    Dim myRange As Range
    Dim myCell As Range
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        .InitialFileName = Application.DefaultFilePath & "\"
        If .Show = 0 Then Exit Sub
        myFolder = .SelectedItems(1)
    End With
    
    Set myRange = Selection
    
    For Each myCell In myRange
        myFileName = myCell.Value
        If Dir(myFolder & "\" & "*" & myFileName & "*") = "" Then
            myCell.Offset(0, 1) = "File Doesn't Exists."
        Else
            myCell.Offset(0, 1) = "File Exists"
        End If
    Next myCell
End Sub

This has been covered so many times before. Please search for `Search directory and sub directory` — Siddharth Rout, Oct 06 '22 at 07:16
https://stackoverflow.com/questions/20687810/vba-macro-that-search-for-file-in-multiple-subfolders check this one — Sachin Kohli, Oct 06 '22 at 07:19
So, you want checking if a file named as in the cell, independent of its extension, exists in the folder you picked and its subfolders. Now, should a single occurrence exist, for each such names? Do you only want returning "Exists" or "Does't exist"? Not the path where it has been found, since the folder is selected on the fly? Then, if many occurrences, how they to be returned? — FaneDuru, Oct 06 '22 at 07:42
Like on my example, A1- "FM-ENG-PDE-050 Rev.2" is just part of the whole file name, I just need to search that part cause that the most important part of the name for us, the exact file name in the our folder is "FM-ENG-PDE-052 Rev.2 75N735-0011 Process FMEA.pdf", and that file should be single occurrence only that's why I just need to know if it EXIST or not, if I can put the file path if it exist it will be better. — Zerlie Ann Palaac, Oct 06 '22 at 08:57
I'll also be checking thousand of files, and the whole file name is hard to specify on the cell, the file extension also maybe in pdf, xlsm,xlsx,docx, etc. — Zerlie Ann Palaac, Oct 06 '22 at 09:11

Tim Williams · Accepted Answer · 2022-10-07T00:09:46.100

Try this out: comments inline

Sub Search_myFolder_Network()
    Dim myFolder As String
    Dim myRange As Range, colFiles As Collection
    Dim arrNames, arrMsg, r As Long, msg As String, nm, fName
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        .InitialFileName = Application.DefaultFilePath & "\"
        If .Show = 0 Then Exit Sub
        myFolder = .SelectedItems(1)
    End With
    
    Set colFiles = AllFileNames(myFolder)
    
    Set myRange = Selection
    arrNames = myRange.Value 'assumes one-column contiguous range is selected
    
    For r = 1 To UBound(arrNames, 1)
        msg = "File not found"   'reset message
        fName = arrNames(r, 1)
        For Each nm In colFiles  'loop over all found file names
            If InStr(1, nm, fName, vbTextCompare) > 0 Then
                msg = "File exists"
                Debug.Print "Found " & fName & " in " & nm
                Exit For  'stop checking
            End If
        Next nm
        arrNames(r, 1) = msg 'replace file name with result message
    Next r
    
    myRange.Offset(0, 1).Value = arrNames  'write the results to the next column
    
End Sub

'Return a collection of unique file names given a starting folder and a file pattern
'  e.g. "*.txt"
'Pass False for last parameter if don't want to check subfolders
Function AllFileNames(startFolder As String, Optional subFolders As Boolean = True) As Collection
    Dim fso, fldr, f, subFldr, fpath
    Dim colFiles As New Collection
    Dim colSub As New Collection
    
    Set fso = CreateObject("scripting.filesystemobject")
    colSub.Add startFolder
    Do While colSub.Count > 0
        Set fldr = fso.getfolder(colSub(1))
        colSub.Remove 1
        If subFolders Then
            For Each subFldr In fldr.subFolders
                colSub.Add subFldr.path
            Next subFldr
        End If
        fpath = fldr.path
        If Right(fpath, 1) <> "\" Then fpath = fpath & "\"
        f = Dir(fpath & "*.*") 'Dir is faster...
        Do While Len(f) > 0
            On Error Resume Next 'ignore error if key is already added
            colFiles.Add f, f
            On Error GoTo 0      'stop ignoring errors
            f = Dir()
        Loop
    Loop
    Set AllFileNames = colFiles
End Function

Wow, it works like wonder, thank you so much for your help, I'm not good at vba so this is very helpful. — Zerlie Ann Palaac, Oct 06 '22 at 23:51

Search file name from folder and Subfolder if Exist or not

1 Answers1