File info pull from sub folders only 2-3 levels deep

I currently have a code that will allow the user to pick a folder and then the code will pull the file information for the files in that folder but not for any files in sub folders. I have 7 levels of subfolders containing about 140,000 files. I was wondering if there is a way for me to pull only pull the info of files in subfolder level 2-3 not solely 1 and not from all 7 levels. Thank you for your help.

I don't think the "pasting formula in column 3" section will be relevant for this problem.

The sections that probably matter are "Picking a folder" and "Running through each file in the selected folder"

Sub Compile3()
  Dim oShell As Object
  Dim oFile As Object
  Dim oFldr As Object
  Dim lRow As Long
  Dim iCol As Integer
  Dim vArray As Variant
  vArray = Array(10, 0, 1, 156, 2, 4, 144, 146, 183, 185)

  Set oShell = CreateObject("Shell.Application")

  Dim iRow As Long
   iRow = Cells.find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
   lRow = iRow
'----------------------Picking a folder-------------------------------------


  With Application.FileDialog(msoFileDialogFolderPicker)
    .title = "Select the Folder..."
    If .Show Then
      Set oFldr = oShell.Namespace(.SelectedItems(1))
      With oFldr

      'Don't show update on the screen until the macro is finished
      Application.EnableEvents = False

'---------------Column header information-----------------------------------

        For iCol = LBound(vArray) To UBound(vArray)
          If lRow = 2 Then
            Cells(lRow, iCol + 4) = .getdetailsof(.items, vArray(iCol))
          Else
            Cells(lRow, iCol + 4) = "..."
          End If             
        Next iCol
'---------------Running through each file in the selected folder------------   
        For Each oFile In .items
          lRow = lRow + 1

          For iCol = LBound(vArray) To UBound(vArray)                   
             Cells(lRow, iCol + 4) = .getdetailsof(oFile, vArray(iCol))    
          Next iCol
 ' ---------------Pasting formula in column 3 -----------------------------             
               If lRow < 4 Then
                        Cells(lRow, 3).Formula = "=IFERROR(VLOOKUP(D3,$A$3:$B$10,2,FALSE),""User Not Found"")"

           Else
                    Cells((lRow - 1), 3).Copy
                    Cells(lRow, 3).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    Cells(lRow, 3).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    Application.CutCopyMode = False                                       

           End If              
'------------------------------------------------------------------------------            

        Next oFile
      End With
    End If
Application.EnableEvents = True
  End With  

End Sub

I modified your code to work with arrays and use a recursive function to return the folder file information.

Sub ProcessFolder()
    Dim FolderPath As String
    Dim results As Variant
    Dim Target As Range

    FolderPath = getFileDialogFolder

    If Len(FolderPath) = 0 Then Exit Sub

    getFolderItems FolderPath, results
    CompactResults results

    With Worksheets("Sheet1")
        .Range("C3", .Range("I" & Rows.Count).End(xlUp)).ClearContents
        Set Target = .Range("C3")
        Set Target = Target.EntireRow.Cells(1, 4)
        Target.Resize(UBound(results), UBound(results, 2)).Value = results
        Target.Offset(1, -1).Resize(UBound(results) - 1).Formula = "=IFERROR(VLOOKUP(D3,$A$3:$B$10,2,FALSE),""User Not Found"")"
    End With

End Sub

Sub CompactResults(ByRef results As Variant)
    Dim data As Variant
    Dim x As Long, x1 As Long, y As Long, y1 As Long

    ReDim data(1 To UBound(results) + 1, 1 To UBound(results(0)) + 1)

    For x = LBound(results) To UBound(results)
        x1 = x1 + 1
        y1 = 0
        For y = LBound(results(x)) To UBound(results(x))
            y1 = y1 + 1
            data(x1, y1) = results(x)(y)
        Next
    Next

    results = data
End Sub

Function getFileDialogFolder() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the Folder..."
        .AllowMultiSelect = False
        If .Show Then
            getFileDialogFolder = .SelectedItems(1)
        End If
    End With
End Function

Sub getFolderItems(FolderPath As String, ByRef results As Variant, Optional MaxLevels As Long = 1, Optional oShell As Object, Optional Level As Long)
    Dim oFile As Object, oFldr As Object

    If oShell Is Nothing Then
        ReDim results(0)
        Set oShell = CreateObject("Shell.Application")
    End If

    If Not IsEmpty(results(UBound(results))) Then ReDim Preserve results(UBound(results) + 1)

    Set oFldr = oShell.Namespace(CStr(FolderPath))

    results(UBound(results)) = getFolderFileDetailArray(oFldr.Self, oFldr)
    results(UBound(results))(1) = oFldr.Self.Path
    For Each oFile In oFldr.Items
        ReDim Preserve results(UBound(results) + 1)
        If oFldr.getDetailsOf(oFile, 2) = "File folder" Then
            If Level < MaxLevels Then
                getFolderItems oFile.Path, results, MaxLevels, oShell, Level + 1
            End If
        End If
        results(UBound(results)) = getFolderFileDetailArray(oFile, oFldr)
    Next oFile

End Sub

Function getFolderFileDetailArray(obj As Object, oFldr As Object) As Variant
    Dim iCol As Integer
    Dim vDetailSettings As Variant
    vDetailSettings = Array(10, 0, 1, 156, 2, 4, 144, 146, 183, 185)

    For iCol = LBound(vDetailSettings) To UBound(vDetailSettings)
        vDetailSettings(iCol) = oFldr.getDetailsOf(obj, vDetailSettings(iCol))
    Next iCol

    getFolderFileDetailArray = vDetailSettings

End Function