Список файлов по неполному названию папке. Нужна помощь поправить код

Sub FileList()
    Dim V As String
    Dim BrowseFolder As String
    Dim myPath As String
    myPath = ActiveWorkbook.Path & "\"
    BrowseFolder = CStr(myPath)
    'ActiveWorkbook.Sheets.Add
    Cells.Select
    Selection.Delete Shift:=xlUp
    With Range("A1:B1")
        .Font.Bold = True
        .Font.Size = 12
    End With
    Range("A1").Value = "Имя файла"
    Range("B1").Value = "Путь"
 
 
    ListFilesInFolder BrowseFolder, False
End Sub
 
 
Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
 
    Dim FSO As Object
    Dim SourceFolder As Object
    Dim SubFolder As Object
    Dim FileItem As Object
    Dim r As Long
    
      
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.getfolder(SourceFolderName)
 
    r = Range("A65536").End(xlUp).Row + 1
    For Each FileItem In SourceFolder.Files
        Cells(r, 1).Formula = FileItem.Name
        Cells(r, 2).Formula = FileItem.Path
        r = r + 1
        X = SourceFolder.Path
    Next FileItem
  
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If
 
    Columns("A:B").AutoFit
 
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    
 Dim wsSh As Workbook
  
 
End Sub

    ListFilesInFolder BrowseFolder, False, "*текстовик*.xls*"