Copy data thru searching all drives in PC

Hi,
when i enter FileName under "A6", lets say the Filename is Template,

it will search through all the drive in the PC,example C:\ , D:\ , F:\ and it will then
copy the data of all the Filename with "Template", example "Template 1,Template 2, Template 3"

after copying the data, it will then display a messagebox "P/T Updated"


my codes are shown below

Private Sub CommandButton2_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

    'dimension variables
    Dim wb As Workbook, wsDest1 As Worksheet, wsDest2 As Worksheet
    Dim ws1 As Worksheet, Ws2 As Worksheet, i As Long, Pos As Long
    Dim Folder As String, File As String, Path As String
    'folder to loop through
    Folder = "F:\FYP week12\samples" 'replace with the correct folder name
    'set destination info
    Set wsDest1 = ActiveWorkbook.Sheets(1)
    'Start FileSearch
    With Application.FileSearch
        .LookIn = Folder
        .Filename = [a7] & "*.xls"
        .FileType = msoFileTypeExcelWorkbooks
        .SearchSubFolders = False
        .Execute
        If .Execute > 0 Then
            'loop through all found files
            For i = 1 To .FoundFiles.Count
                'set incidental variables
                Pos = InStrRev(.FoundFiles(i), "\")
                File = Right(.FoundFiles(i), Len(.FoundFiles(i)) - Pos)
                Path = Left(.FoundFiles(i), Pos)
                'check if workbook is open.  if so, set variable to it, else open it
                If IsWbOpen(File) Then
                    Set wb = Workbooks(File)
                Else
                    Set wb = Workbooks.Open(Path & File)
                End If
                'set worksheets to copy data from
                Set ws1 = wb.Sheets(1)
                'copy data
                ws1.Range("D9:CP9").Copy  'change the range to copy
                With wsDest1.Cells(Rows.Count, 2).End(xlUp).Offset(1)
                    .PasteSpecial (xlValues)
                    .PasteSpecial (xlFormats)
                    '.PasteSpecial xlValues
                End With
                wb.Close
            Next i
        End If
    End With
    
    Set wsDest1 = Nothing: Set wsDest2 = Nothing: Set ws1 = Nothing
    Set Ws2 = Nothing: Set wb = Nothing

Application.ScreenUpdating = False
Application.DisplayAlerts = False

End Sub
Function IsWbOpen(wbName As String) As Boolean
    On Error Resume Next
    IsWbOpen = Len(Workbooks(wbName).Name)
End Function

is it able to check all the drives and folders in the PC with the filesname, examples, "Template","template1","template2"

no 1 helping?