Copy Specific Cells from files under Folder/SubFolder

Option Explicit
Dim objFso As Object, objFolder As Object, pathname As String, eachfile As Variant, objFolder1 As Object, eachfolder As Object
Dim tempcounter As Long, wb As Workbook, i As Integer, j As Integer


Sub copyFromSpecificfolderandsubfolder()
On Error Resume Next
pathname = "D:\Somu\ExcelClasses Notes"
Set objFso = New Scripting.FileSystemObject
Set objFolder = objFso.GetFolder(pathname)
Set objFolder1 = objFolder.SubFolders
Set wb = ThisWorkbook
tempcounter = 1
Call readfile(objFolder, tempcounter)

For Each eachfolder In objFolder1

Call readfile(eachfolder, tempcounter)

Next
tempcounter = 0
End Sub

Sub readfile(myFolder As Scripting.Folder, tempcounter)

For Each eachfile In myFolder.Files
    If checkExtension(eachfile) = True Then
        tempcounter = tempcounter + 1
 
        Workbooks.Open eachfile
        ActiveWorkbook.Sheets(1).Range("A2:C2").Copy wb.Sheets(1).Range("A" & tempcounter)
        ActiveWorkbook.Close
    End If
Next
End Sub

Public Function checkExtension(eachfile) As Boolean
i = InStr(1, eachfile, ".")
j = Len(eachfile)

Select Case Mid(eachfile, i + 1, (j - i))
    Case "xls"
        checkExtension = True
    Case "Xlsm"
        checkExtension = True
    Case "xlsx"
        checkExtension = True
    Case "xlsb"
        checkExtension = True
    Case Else
        checkExtension = False
End Select
End Function