List files with some specific text from the folders that also contains specific text

[thorblow]

Hi all,

Inside the path C:\Users\user\Documents\Test Searcher I have a lot of folders that have the material and the customer name as a part of the folder string name:

3154- Shoes Puma
3155- Shirt Puma
3156- Shoes Adidas
3157- Belt Nike

etc...

Inside these folders then there are still more subfolders with a lot of files. Also note that there are More than 3000 folders....

My goal was to achieve a Macro to list all the files that the name of the file contains the specific text I would put in A2 through all the subfolders from the main folders that contains part of the text I would put in A1.

Ex: From all the folders inside the path C:\Users\user\Documents\Test Searcher that for example contains the words "Shoes" to then search inside all the subfolders of that specific folders all the files containing the file name text "template"

So, in A2 would appear part of the file name "Template" and in A1 part of the folder name "Shoes".

Because I'm quite a begginer, the closest code I could achieve is the one created by Akatrouble based on this thread https://www.excelforum.com/excel-pro...ple-paths.html I edited the code to achieve the following:

Based on the folder (and all the subfolders) from the path I put in A1 to look for all the files that contains in the file name the text I put in A2 and make a list to be pasted in the sheet named "Test Searcher"

'Force the explicit delcaration of variables
Option Explicit
Sub ListFiles()
    'Set a reference to Microsoft Scripting Runtime by using
    'Tools > References in the Visual Basic Editor (Alt+F11)
    
    'Declare the variables
    Dim objFSO As Scripting.FileSystemObject
    Dim objTopFolder As Scripting.Folder
    Dim strTopFolderName As String
   


    'Assign the folder to analize:
    strTopFolderName = Range("A1")

    
    ' create a new sheet
    'ThisWorkbook.Sheets.Add(after:=Sheets(Sheets.Count)).Name = Mid$(strTopFolderName, InStrRev(strTopFolderName, "\") + 1)
    'Paste in the existing sheet:
    Sheets("Test Searcher").Select
    
    'Insert the headers for Columns A through F
    Range("A1").Value = "File Name"
    Range("B1").Value = "File Size"
    Range("C1").Value = "File Type"
    Range("D1").Value = "Date Created"
    Range("E1").Value = "Date Last Accessed"
    Range("F1").Value = "Date Last Modified"
    Range("G1").Value = "File Path"
    
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    'Get the top folder
    Set objTopFolder = objFSO.GetFolder(strTopFolderName)
    
    'Call the RecursiveFolder routine
    Call RecursiveFolder(objTopFolder, True)
    
    'Change the width of the columns to achieve the best fit
    Columns.AutoFit
   
    
End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder, _
    IncludeSubFolders As Boolean)

    'Declare the variables
    Dim objFile As Scripting.File
    Dim objSubFolder As Scripting.Folder
    Dim NextRow As Long
    
    'Find the next available row
    NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    'Loop through each file in the folder
    For Each objFile In objFolder.Files
    If InStr(objFile.Name, Worksheets("Sheet1").Range("A2").Value) Then
        Cells(NextRow, "A").Value = objFile.Name
        Cells(NextRow, "B").Value = Format(objFile.Size, "0,000") & " KB"
        Cells(NextRow, "C").Value = objFile.Type
        Cells(NextRow, "D").Value = objFile.DateCreated
        Cells(NextRow, "E").Value = objFile.DateLastAccessed
        Cells(NextRow, "F").Value = objFile.DateLastModified
        Cells(NextRow, "G").Value = objFile.Path
        NextRow = NextRow + 1
        End If
    Next objFile
    
    'Loop through files in the subfolders
    If IncludeSubFolders Then
        For Each objSubFolder In objFolder.SubFolders
            Call RecursiveFolder(objSubFolder, True)
        Next objSubFolder
    End If
    
End Sub

Although it is not exactly what I want, I still could work with it. The code works good, but I'm the dealing with a small issue that I certainly don't know how to solve. For some reason the part from this code is case sensitive:

    If InStr(objFile.Name, Worksheets("Sheet1").Range("A2").Value) Then
        Cells(NextRow, "A").Value = objFile.Name

meaning if I put in range A2 the text "plate" it will list all the files that have the name "Template" for example. But if in A2 I put "PLATE" or "TEMPLATE" it will not list any file if the file name is written as "Template". I've tried to use Lcase function, but because I have some different text possibilites it fails to work in some cases. So my will would be to list all the files without taking into account any capitalization, therefore as a total case insensitive.

Is there any way to achieve that? Or I should create a completly new code?

Thanks in advance for your kind attention!

[TMS]

Try:

     If InStr(LCase(objFile.Name), LCase(Worksheets("Sheet1").Range("A2").Value)) Then

[thorblow]

Hi TMS, thanks for your fast response.

As I mentioned, I already tried the function Lcase but the outcome is not the desired one. It really needs to be completely case insensitive!

[TMS]

Hi TMS, thanks for your fast response.

As I mentioned, I already tried the function Lcase but the outcome is not the desired one. It really needs to be completely case insensitive!

Ah, lots of words. I missed that.

[thorblow]

Hi again TMS, I must apologize, your correction it actually worked!

My statement when I said that Lcase function didn't work, was because I tried like this:

If InStr(objFile.Name), LCase(Worksheets("Sheet1").Range("A2").Value) Then

but with your correction then it works properly as I wanted:

If InStr(LCase(objFile.Name), LCase(Worksheets("Sheet1").Range("A2").Value)) Then

Anyway, since the new code of jindon appeared, I would rather go for the real macro I would like to have!

[jindon]

This is my old code.
Wild card serach.

Enter
A1:
*Shoes*

A2:
*Template*.xlsx
or just without file extension like "*Template* for all file types.

When file dialog appears, select main folder.

Sub test()
    Dim myDir As String, temp(), myList
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            myDir = .SelectedItems(1)
        End If
    End With
    myList = SearchFiles(myDir, [a2], 0, temp(), [a1])
    If Not IsError(myList) Then
        Sheets(1).Cells(1, 3).Resize(UBound(myList, 2), 2).Value = _
        Application.Transpose(myList)
    Else
        MsgBox "No file found"
    End If
End Sub
 
 
Private Function SearchFiles(myDir As String _
    , myFileName As String, n As Long, myList() _
    , subFolName As String) As Variant
    Dim fso As Object, myFolder As Object, myFile As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each myFolder In fso.getfolder(myDir).subfolders
        If myFolder.Name Like subFolName Then
            SearchFiles = SearchFiles(myFolder.Path, myFileName, _
                n, myList, subFolName)
        End If
    Next
    For Each myFile In fso.getfolder(myDir).Files
        If (Not myFile.Name Like "~$*") _
        * (myFile.Path & "\" & myFile.Name <> ThisWorkbook.FullName) _
        * (UCase(myFile.Name) Like UCase(myFileName)) Then
            n = n + 1
            ReDim Preserve myList(1 To 2, 1 To n)
            myList(1, n) = myDir
            myList(2, n) = myFile.Name
        End If
    Next
    SearchFiles = IIf(n > 0, myList, CVErr(xlErrRef))
End Function

[thorblow]

@jindon

Hi jindon,

Your proposal it is actually what Im really looking for! But for some reason it doesn't work it keeps me saying "no file found" when I choose the main folder "C:\Users\user\Documents\Test Searcher" but when I choose the actual subfolder where I know that there are the files, then it works... What might be the problem that doesn't search properly inside the subfolders?

PS: I edited because at first I thought that it didn't worked at all, but then I realize that it partially worked... Le'ts see if I there is a way to go deep to all the subfolders!

[TMS]

Hi again TMS, I must apologize, your correction it actually worked!

You're welcome. Thanks for the rep.

[jindon]

OOps...
Can you change

Sub test()
    Dim myDir As String, temp(), myList, fn As String, subFol As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1)
    End With
    If myDir = "" Then Exit Sub
    fn = [a2]
    subFol = [a1]
    myList = SearchFiles(myDir, fn, 0, temp(), subFol)
    If Not IsError(myList) Then
        Sheets(1).Cells(1, 3).Resize(UBound(myList, 2), 2).Value = _
        Application.Transpose(myList)
    Else
        MsgBox "No file found"
    End If
End Sub
 
Private Function SearchFiles(myDir As String _
    , fn As String, n As Long, myList() _
    , subFol As String) As Variant
    Dim fso As Object, myFolder As Object, myFile As Object, x
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each myFile In fso.getfolder(myDir).Files
        x = Split(myDir, "\")
        If UCase(x(UBound(x))) Like UCase(subFol) Then
            If (Not myFile.Name Like "~$*") _
            * (myFile.Path & "\" & myFile.Name <> ThisWorkbook.FullName) _
            * (UCase(myFile.Name) Like UCase("*" & fn)) Then
                n = n + 1
                ReDim Preserve myList(1 To 2, 1 To n)
                myList(1, n) = myDir
                myList(2, n) = myFile.Name
            End If
        End If
    Next
    For Each myFolder In fso.getfolder(myDir).subfolders
        SearchFiles = SearchFiles(myFolder.Path, fn, _
        n, myList, subFol)
    Next
    SearchFiles = IIf(n > 0, myList, CVErr(xlErrRef))
End Function

[thorblow]

@jindon

Thank you for your fast reply, I don't know if you realized that I just edited my message few minutes ago, so I'm not sure if you took into consideration the previous message...

Anyway, I have just tried your modifcation it and I keep having the same issue, the macro works properly when I select the path deep in the subfolder that I know that I have the files, but it doesn't work If I choose the main folder that should apply the condition in A1.

Attachment 871491

and inside the 3154, etc... folders there are subfolders such as Commercial, Performance, etc... and then inside you can find the files that contains the condition in A2

[jindon]

Have you tried the attached workbook named GetFiles.xlsm?

[jindon]

OOps, so sorry, uploaded a wrong file.

#9 has been edited, so try again....

[thorblow]

Hi @jindon,

Sorry for my late reply, real life is very demanding sometimes :D

I tried your Excel but the issue is that doesn't go deep enough to more subfolders. In the zip you sent me, try to add more subfolders inside the subfolders and then you will see that the macro fails to work unless you will select the path of the previous folder which contains the file you are looking for...

[thorblow]

@jindon,

With the code I already shared at my first post, is it possible to edited and put there the condition to search into the first folder that contains some specific text? Just saying if it would be faster to find a solution... In the meantime I'm trying by myself if I'm able to achieve it...

[jindon]

Are you sure?

It is picking up all the files.

If the attached doesn't work for you, I will leave this to the others.