List files in folder path using keyword?

[mattbnorris]

Hello, I'm currently using the VBA below to create a list of files from the folder paths in C5 and C6 of my excel sheet. Is there a way I can adjust the code so it only returns files in the folder that contain a specific word?

Sub ListFiles()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim objSubFolder As Object
Dim i As Integer

Dim fPathPrior As String
Dim fPathCurr As String

fPathPrior = Range("C5").Value
fPathCurr = Range("C6").Value

Range("B9:T10000").Value = ""
Range("B9:T10000").Interior.Color = vbWhite

On Error GoTo errHandler

'Create an instance of the FileSystemObject

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolderPrior = objFSO.GetFolder(fPathPrior)
Set objFolderCurr = objFSO.GetFolder(fPathCurr)

r = 9

'loops through each file in the directory and prints their names and path

For Each objFile In objFolderPrior.Files

Cells(r, 2) = objFile.Name
Cells(r, 11) = objFile.path

r = r + 1

Next objFile

r = 9

'loops through each file in the directory and prints their names and path

For Each objFile In objFolderCurr.Files

Cells(r, 12) = objFile.Name
Cells(r, 21) = objFile.path

r = r + 1

Next objFile

On Error GoTo 0
Exit Sub

errHandler:

MsgBox "FOLDER PATH FOR NEW SHEETS DOES NOT EXIST!", , "Error"

Exit Sub

End Sub

 

[Fluff]

You can do that using Dir like

Sub ListFiles()

Dim fPathPrior As String
Dim fPathCurr As String
Dim Fname As String

fPathPrior = Range("C5").Value
fPathCurr = Range("C6").Value

Range("B9:T10000").Value = ""
Range("B9:T10000").Interior.Color = vbWhite

On Error GoTo errHandler

Fname = Dir(fPathPrior & "*some text*")
R = 9
Do While Fname <> ""
   Cells(R, 2) = Fname
   Cells(R, 11) = fPathPrior & Fname
   R = R + 1
   Fname = Dir
Loop


On Error GoTo 0
Exit Sub

errHandler:

MsgBox "FOLDER PATH FOR NEW SHEETS DOES NOT EXIST!", , "Error"


End Sub

 

[mattbnorris]

You can do that using Dir like

Sub ListFiles()

Dim fPathPrior As String
Dim fPathCurr As String
Dim Fname As String

fPathPrior = Range("C5").Value
fPathCurr = Range("C6").Value

Range("B9:T10000").Value = ""
Range("B9:T10000").Interior.Color = vbWhite

On Error GoTo errHandler

Fname = Dir(fPathPrior & "*some text*")
R = 9
Do While Fname <> ""
   Cells(R, 2) = Fname
   Cells(R, 11) = fPathPrior & Fname
   R = R + 1
   Fname = Dir
Loop


On Error GoTo 0
Exit Sub

errHandler:

MsgBox "FOLDER PATH FOR NEW SHEETS DOES NOT EXIST!", , "Error"


End Sub

Hello Fluff, thanks for your quick response, however I don't think this is quite what i'm looking for.

That Fname variable will be the folder path from C5 in the sheet concatenated with the file name... In my folder path there are multiple files with different names, I want this VBA program to list a certain subset of the files from the folder based on a keyword. From the example below there are many files within the folder path, but I only want the ones that contain the word 'Exhibits' to be found and listed. Can this be done without moving and isolating the files to their own folder?

Example:

List of files in folder path	List of files to be listed by the VBA program
Sales 2407.xlsx	Exhibits - Cars 05.xlsx
Expenditure 2382.xlsx	Exhibits - Bus 05.xlsx
Exhibits - Cars 05.xlsx	Exhibits - Taxis 05.xlsx
Exhibits - Bus 05.xlsx	Exhibits - Project 05.xlsx
Exhibits - Taxis 05.xlsx
Exhibits - Project 05.xlsx
Calendar 3434.xlsx
Management Control.xlsx
Pricing 4343.xlsx

 

[Fluff]

If you use

Fname = Dir(fPathPrior & "*Exhibits*")

It will do what your code does for the path in C5. You can then duplicate this part

Fname = Dir(fPathPrior & "*some text*")
R = 9
Do While Fname <> ""
   Cells(R, 2) = Fname
   Cells(R, 11) = fPathPrior & Fname
   R = R + 1
   Fname = Dir
Loop

using the path in C6

 

[mattbnorris]

If you use

Fname = Dir(fPathPrior & "*Exhibits*")

It will do what your code does for the path in C5. You can then duplicate this part

Fname = Dir(fPathPrior & "*some text*")
R = 9
Do While Fname <> ""
   Cells(R, 2) = Fname
   Cells(R, 11) = fPathPrior & Fname
   R = R + 1
   Fname = Dir
Loop

using the path in C6

Thanks Fluff, understand that I will need to replicate the code for the second list.

Sub ListFiles()

Dim fPathPrior As String
Dim fPathCurr As String
Dim Fname As String

fPathPrior = Range("C5").Value
fPathCurr = Range("C6").Value

Range("B9:T10000").Value = ""
Range("B9:T10000").Interior.Color = vbWhite

On Error GoTo errHandler

Fname = Dir(fPathPrior & "*Exhibits*")
R = 9

Do While Fname <> ""
 Cells(R, 2) = Fname
 Cells(R, 11) = fPathPrior & Fname
 R = R + 1
 Fname = Dir
Loop

On Error GoTo 0
Exit Sub

errHandler:
MsgBox "FOLDER PATH FOR NEW SHEETS DOES NOT EXIST!", , "Error"
Exit Sub

End Sub

The code wasn't working as first as it was skipping past the Do While Loop, however I realised that the file path that I had stated in C5 didn't have a \ at the end so it when concatenating the path and name it was causing the Fname variable to blank out.

I have now fixed this and it's working perfectly, thanks so much for the help!

 

[Fluff]

Glad you sorted it & thanks for the feedback.