VBA Directory File Search using list within Excel - file

Question

I'm currently trying to edit a macro a colleague of mine currently uses, the script currently opens a message box that allows you to enter in a string, which is then searched for and results are pasted into the workbook. I would like to change this so it searches for a list already within the spreadsheet, and then for the results to be pasted on the next worksheet. I'm not sure if this is actually possible or not, which is where my main struggle is. Below is the current code, I assume all that is needed is for the variable range to be placed in that stars "msg = "Enter file name and Extension"
Sub Filesearch()
Dim myDir As String, temp(), myList, myExtension As String
Dim SearchSubFolders As Boolean, Rtn As Integer, msg As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
myDir = .SelectedItems(1)
End If
End With
msg = "Enter File name and Extension" & vbLf & "following wild" & _
" cards can be used" & vbLf & "* # ?"
myExtension = Application.InputBox(msg)
If (myExtension = "False") + (myExtension = "") Then Exit Sub
Rtn = MsgBox("Include Sub Folders ?", vbYesNo)
SearchSubFolders = Rtn = 6
myList = SearchFiles(myDir, myExtension, 0, temp(), SearchSubFolders)
If Not IsError(myList) Then
Sheets(1).Cells(1).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() _
, Optional SearchSub As Boolean = False) As Variant
Dim fso As Object, myFolder As Object, myFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
For Each myFile In fso.getfolder(myDir).Files
Select Case myFile.Attributes
Case 2, 4, 6, 34
Case Else
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
End Select
Next
If SearchSub Then
For Each myFolder In fso.getfolder(myDir).subfolders
SearchFiles = SearchFiles(myFolder.Path, myFileName, _
n, myList, SearchSub)
Next
End If
SearchFiles = IIf(n > 0, myList, CVErr(xlErrRef))
End Function

Answer 1

Suggest the use of Defined Name Ranges to hold the user maintained list (as show in the picture below)
Let’s add a worksheet for user input of the requirements called “_Tables”.
Then create Defined Name Ranges, for users to enter the requirements, called "_Path", "_Files" and "_SubFldrs"
Then replace all the user’s input in current code
REPLACE THIS
''' With Application.FileDialog(msoFileDialogFolderPicker)
''' If .Show Then
''' myDir = .SelectedItems(1)
''' End If
''' End With
''' msg = "Enter File name and Extension" & vbLf & "following wild" & _
''' " cards can be used" & vbLf & "* # ?"
''' myExtension = Application.InputBox(msg)
''' If (myExtension = "False") + (myExtension = "") Then Exit Sub
''' Rtn = MsgBox("Include Sub Folders ?", vbYesNo)
''' SearchSubFolders = Rtn = 6
with this in order to read the requirements from the worksheet "_Tables"
Set WshLst = ThisWorkbook.Sheets("_Tables")
sPath = WshLst.Range("_Path").Value2
aFleKey = WshLst.Range("_Files").Value2
bSbFldr = UCase(WshLst.Range("_SubFldrs").Value2) = UCase("YES")
aFleKey = WorksheetFunction.Transpose(aFleKey)
then Process the lists
See below the entire code below. It's necessary to have the statement Option Base 1 at the top of the module
Option Explicit
Option Base 1
Sub Fle_FileSearch_List()
Dim WshLst As Worksheet
Dim sPath As String
Dim aFleKey As Variant, vFleKey As Variant
Dim bSbFldr As Boolean
Dim vFleLst() As Variant
Dim lN As Long
Set WshLst = ThisWorkbook.Sheets("_Tables")
sPath = WshLst.Range("_Path").Value2
aFleKey = WshLst.Range("_Files").Value2
bSbFldr = UCase(WshLst.Range("_SubFldrs").Value2) = UCase("YES")
aFleKey = WorksheetFunction.Transpose(aFleKey)
Rem To clear output location
ThisWorkbook.Sheets(1).Columns(1).Resize(, 2).Clear
Rem Process input list
For Each vFleKey In aFleKey
If (vFleKey <> "False") * (vFleKey <> "") Then
Call Fle_FileSearch_Fldrs(sPath, CStr(vFleKey), lN, vFleLst, bSbFldr)
End If: Next
Rem Validate Results & List Files found
If lN > 1 Then
ThisWorkbook.Sheets(1).Cells(1).Resize(UBound(vFleLst, 2), 2) _
.Value = Application.Transpose(vFleLst)
Else
MsgBox "No file found"
End If
End Sub
Also some adjustments to the function (now a procedure) to allow the process of the list.
Sub Fle_FileSearch_Fldrs(sPath As String, _
sFleKey As String, lN As Long, vFleLst() As Variant, _
Optional bSbFldr As Boolean = False)
Dim oFso As Object, oFolder As Object, oFile As Object
Set oFso = CreateObject("Scripting.FileSystemObject")
If lN = 0 Then
lN = 1 + lN
ReDim Preserve vFleLst(1 To 2, 1 To lN)
vFleLst(1, lN) = "Files Found - Path"
vFleLst(2, lN) = "Files Found - Name"
End If
For Each oFile In oFso.GetFolder(sPath).Files
Select Case oFile.Attributes
Case 2, 4, 6, 34
Case Else
If (Not oFile.Name Like "~$*") * _
(oFile.Path & "\" & oFile.Name <> ThisWorkbook.FullName) * _
(UCase(oFile.Name) Like UCase(sFleKey)) Then
lN = lN + 1
ReDim Preserve vFleLst(1 To 2, 1 To lN)
vFleLst(1, lN) = sPath
vFleLst(2, lN) = oFile.Name
End If: End Select: Next
If bSbFldr Then
For Each oFolder In oFso.GetFolder(sPath).subfolders
Call Fle_FileSearch_Fldrs(oFolder.Path, sFleKey, lN, vFleLst, bSbFldr)
Next: End If
End Sub