Excel VBA search subfolders - excel

Question

This is what i got, it works, but it doesn't search the subfolders of "K:". What am i doing wrong?
Sub Search()
Dim RGFileName As String
Dim RGNumber As String
Dim Path As String
Path = "K:\"
RGNumber = InputBox("Input RG-Number (33xxxx)", "RG-Number")
RGFileName = Dir(Path & "*" & RGNumber & "*.xlsm")
If RGFileName <> "" Then
Workbooks.Open Path & RGFileName
End If
End Sub

Answer 1

Using a separate function to perform the search - returns a collection of File objects:
Sub Search()
Dim RGFileName As String
Dim RGNumber As String
Dim Path As String, allFiles As Collection
Path = "K:\"
RGNumber = InputBox("Input RG-Number (33xxxx)", "RG-Number")
Set allFiles = GetMatches(Path, "*" & RGNumber & "*.xlsm")
If allFiles.Count > 0 Then
Workbooks.Open allFiles(1).Path
Else
MsgBox "No match"
End If
End Sub
'Return a collection of file objects given a starting folder and a file pattern
' e.g. "*.txt"
'Pass False for last parameter if don't want to check subfolders
Function GetMatches(startFolder As String, filePattern As String, _
Optional subFolders As Boolean = True) As Collection
Dim fso, fldr, f, subFldr
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
For Each f In fldr.Files
If UCase(f.Name) Like UCase(filePattern) Then colFiles.Add f
Next f
If subFolders Then
For Each subFldr In fldr.subFolders
colSub.Add subFldr.Path
Next subFldr
End If
Loop
Set GetMatches = colFiles
End Function
Edit: this will look for the first match and return the full path to the file
Function MatchFirstFile(startFolder As String, filePattern As String) As String
Dim colSub As New Collection, f, fld
colSub.Add startFolder
Do While colSub.Count > 0
fld = colSub(1)
colSub.Remove 1
f = Dir(fld, vbDirectory)
Do While Len(f) > 0
If GetAttr(fld & f) = vbDirectory Then
If f <> "." And f <> ".." Then 'ignore parent and current folders
colSub.Add fld & f & "\"
End If
Else
If UCase(f) Like UCase(filePattern) Then
MatchFile = fld & f
Exit Function
End If
End If
f = Dir()
Loop
Loop
End Function